Sub test()
Dim tableau(1000)
Dim c As Range
Dim d As Range
Dim x, i As Long
Dim fin_de_ligne As Long
fin_de_ligne = Range("B65536").End(xlUp).Row
For Each c In Sheets("Résultat souhaité").Range("d2:e" & fin_de_ligne)
tableau(x) = c
x = x + 1
Next c
For Each d In Sheets("Résultat souhaité").Range("b2:c" & fin_de_ligne)
For i = LBound(tableau) To (x - 1)
If d Like "*" & tableau(i) & "*" Or d Like "*" & Left(tableau(i), 4) & "*" Or (d Like "*" & Left(tableau(i), 3) & "*" _
And d Like "*" & Right(tableau(i), 3) & "*") And d.Offset(0, 4) = "" Then d.Offset(0, 4) = tableau(i)
Next i
Next d
End Sub