Sub ess()
Dim t(), i As Long, m As Object, x As Long
Set m = CreateObject("Scripting.Dictionary")
t = Range("a2:b" & Cells(Rows.Count, 1).End(3).Row)
For i = 1 To UBound(t)
If m.Exists(t(i, 1)) Then
t(m(t(i, 1)), 2) = t(m(t(i, 1)), 2) & "ù" & t(i, 2)
Else
x = x + 1
t(x, 1) = t(i, 1): t(x, 2) = t(i, 2): m(t(i, 1)) = x
End If
Next i
[e2].Resize(x, 2) = t
Range("f2:f" & m.Count + 1).TextToColumns Other:=1, OtherChar:="ù" ' "eclate" colonne
End Sub