Bonjour
imaginons que je mette le tableau de BASE dans la colonne E et F comme ceci:
et que dans les autres feuilles au lieu de commencer à copier dans la cellule B11, je veux que les valeurs soient dans la cellule B21?
pouvez vous me donner exactement la même chose mais avec ses modifications s'il vous plaît?
j'ai essayé de le faire mais je me suis emmêler les pinceaux
On peut aussi trouver la position des données de Base où qu'elles soient : il faut cependant que la structure soit inchangée
Sub Moulinette3()
Dim tref, k&, i&, j&, t, dico As New dictionary, nf&, nc@, deb, Dossier As String, Col As Integer, Lig As Long, Coin As Range
deb = Timer: Application.ScreenUpdating = False
Dossier = Range("Dossier")
Fichier = Dir(Dossier)
Do While Fichier <> ""
Set WK = Workbooks.Open(Dossier & Fichier)
With WK.Sheets("Base")
.Move Before:=Sheets(1)
Set Coin = .Cells.Find(What:="*", After:=.Range("A1"), LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False)
Col = Coin.Column
Lig = Coin.Row + 1
Lig2 = Coin.End(xlDown).Row
If .FilterMode Then .ShowAllData
tref = .Range(.Cells(Lig, Col), .Cells(Lig2, Col + 1))
Set dico = CreateObject("scripting.dictionary")
dico.CompareMode = TextCompare
tref = Intersect(Rows("3:" & Rows.Count), .Range("a3").CurrentRegion)
For i = 1 To UBound(tref)
If Trim(tref(i, 1)) <> "" Then dico(tref(i, 1)) = tref(i, 2)
Next i
End With
For k = 2 To WK.Worksheets.Count
With WK.Worksheets(k)
nf = nf + 1
If .FilterMode Then .ShowAllData
t = Intersect(.Columns("b").Resize(, Columns.Count - 1), .Range("b2").CurrentRegion)
ReDim res(1 To UBound(t), 1 To UBound(t, 2))
For i = 1 To UBound(t)
For j = 1 To UBound(t, 2)
nc = nc + 1
If dico.Exists(t(i, j)) Then res(i, j) = dico(t(i, j))
Next j
Next i
.Range("b11").Resize(Rows.Count - 11, Columns.Count - 1).Clear
With .Range("b11").Resize(UBound(res), UBound(res, 2))
.Value = res
.Borders.LineStyle = xlContinuous
.HorizontalAlignment = xlCenter
End With
End With
Next k
WK.Close SaveChanges:=True
Fichier = Dir()
Loop
MsgBox Format(nf, "#,##0\ feuilles examinées.") & vbLf & _
Format(nc, "#,##0\ cellules traitées.") & vbLf & _
"en " & Format(Timer - deb, "#,##0.0\ s.")
End Sub