Bonjour,
Un exemple :
Sub test()
Dim Cel As Range, Dico As Object
Set Dico = CreateObject("Scripting.Dictionary")
For Each Cel In Union(Range("D2:N2"), Range("D7:N7"), Range("D11:Q11"), Range("D16:O16"), Range("D21:AE21"))
Dico(Cel.Value) = Cel.Offset(1, 0)
Next Cel
For Each Cel In Range("A1:A75")
If Dico.Exists(Cel.Value) Then Cel.Offset(0, 1) = Dico(Cel.Value)
Next Cel
End Sub