Sub ChercherNoms()
Dim Lig As Long, DLig As Long, i As Long, ind As Long
Dim sh1 As Worksheet, sh2 As Worksheet
Dim Nom As String
Set sh1 = Sheets("Codes et noms")
Set sh2 = Sheets("Name")
DLig = sh1.Range("A65536").End(xlUp).Row
Nom = ""
ValCherche = ""
For Lig = 2 To DLig
x = Split(sh1.Cells(Lig, 11), "-")
For i = LBound(x) To UBound(x)
If x(i) <> "" Then
For ind = 1 To Len(x(i))
If IsNumeric(Mid(x(i), ind, 1)) Then
ValCherche = ValCherche & Mid(x(i), ind, 1)
End If
Next
Set a = sh2.Range("A:A").Find(ValCherche, lookat:=xlPart)
If Not a Is Nothing Then
If Nom = "" Then
Nom = sh2.Cells(a.Row, 12)
Else
Nom = Nom & Chr(10) & sh2.Cells(a.Row, 12)
End If
End If
ValCherche = ""
End If
Next i
If Nom <> "" Then
sh1.Cells(Lig, 12) = Nom
End If
Nom = ""
Next Lig
End Sub