Sub Macro1()
Dim Derl As Long, DerlBase As Long, i As Long
Dim MonMsg As String, Compar As String
Dim Dico, TabBase
Set Dico = CreateObject("Scripting.Dictionary")
Derl = Worksheets("données").Range("A" & Rows.Count).End(xlUp).Row
DerlBase = Worksheets("base").Range("A" & Rows.Count).End(xlUp).Row
MonMsg = "Références non trouvées : " & vbLf
'******** Creation d' un "Dico" contenant les référence de la base puis le N° de ligne (-1)
TabBase = Worksheets("base").Range("A2:A" & DerlBase)
For i = LBound(TabBase) To UBound(TabBase)
Dico(TabBase(i, 1)) = i
Next i
'** fin création Dico
'**** traitement des lignes Données
For i = 2 To Derl
If Worksheets("données").Cells(i, 4) = "###" Or Worksheets("données").Cells(i, 7) = "###" Then
Compar = Worksheets("données").Cells(i, 3)
If Dico.Exists(Compar) Then
Worksheets("données").Cells(i, 4) = Worksheets("base").Cells(Dico.Item(Compar) + 1, 2)
Worksheets("données").Cells(i, 7) = Worksheets("base").Cells(Dico.Item(Compar) + 1, 3)
Worksheets("données").Cells(i, 5) = Worksheets("base").Cells(Dico.Item(Compar) + 1, 7)
Compt = Compt + 1
Else
MonMsg = MonMsg & "Ligne : " & i & " référence : " & Compar & vbLf
End If
End If
Next
'******* Fin Traitement
MsgBox Compt & "Références mises à jour " & vbLf & MonMsg
End Sub