Sub Recheche()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim ar
Dim Dic
Dim rg As Range, c As Range
Dim i As Long
Dim rep As String
Set ws1 = Sheets("CSARR")
Set ws2 = Sheets("101")
Set Dic = CreateObject("Scripting.Dictionary")
ar = ws1.Range("A59:B" & ws1.Range("A" & Rows.Count).End(xlUp).Row)
For i = 1 To UBound(ar, 1)
If ar(i, 1) <> "" Then
If Not Dic.exists(ar(i, 1)) Then
Dic.Add ar(i, 1), Split(ar(i, 2), vbLf)(0)
End If
End If
Next i
rep = "Résultat de la recherche : " & vbLf
For Each c In ws2.Range("C5:C16")
rep = rep & c & vbTab & Dic(c.Value) & vbLf
Next c
MsgBox rep
End Sub