Sub es()
Dim t(), i As Long, m As Object, a, b, r, z
Set m = CreateObject("Scripting.Dictionary")
t = Range("a8:e" & Cells(Rows.Count, 1).End(3).Row)
For i = 1 To UBound(t)
Set r = Range("m13:an16").Find(What:=t(i, 5), LookIn:=xlValues, lookat:=xlWhole)
If Not r Is Nothing Then z = t(i, 5) Else z = ""
m(t(i, 1)) = m(t(i, 1)) & " " & z
Next i
a = m.Keys: b = m.Items
For i = 0 To m.Count - 1
MsgBox a(i) & " Emplacement " & b(i)
Next i
m.RemoveAll: Erase t
End Sub