Sub MAJ()
Dim tablo, d As Object, i&
With Sheets("SOURCE").[A1].CurrentRegion
.Sort .Columns(2), xlAscending, .Columns(1), , xlAscending, Header:=xlYes 'tri
tablo = .Resize(, 2)
End With
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
For i = 2 To UBound(tablo)
If d.exists(tablo(i, 2)) Then
d(tablo(i, 2)) = d(tablo(i, 2)) & " ; " & tablo(i, 1)
Else
d(tablo(i, 2)) = tablo(i, 1)
End If
Next
With Sheets("LISTE").[A1].CurrentRegion.Resize(, 4)
tablo = .Value
For i = 2 To UBound(tablo)
tablo(i, 3) = d(tablo(i, 1))
tablo(i, 4) = Len(tablo(i, 3)) - Len(Replace(tablo(i, 3), ";", "")) + 1
Next
.Value = tablo
End With
End Sub