Sub ListeInverses()
Set f1 = Sheets("feuil1")
Set f2 = Sheets("feuil2")
Set d = CreateObject("Scripting.Dictionary")
For Each c In f1.Range("a1:a" & f1.[a65000].End(xlUp).Row)
If c.Value <> "" Then
If c.Offset(, 1) <> "" Then d(c.Value) = d(c.Value) & c.Offset(, 1) & ":"
End If
Next c
col = 2
For Each c In d.keys
f2.Cells(2, col) = c
a = Split(d.Item(c), ":")
f2.Cells(2, col).Offset(1).Resize(UBound(a) + 1) = Application.Transpose(a)
col = col + 1
Next c
End Sub