Bonjour,
si bcp de données et qu'elles peuvent être triés avant:
Sub Lister()
Set d1 = CreateObject("Scripting.Dictionary")
Set Rng = Range("A4:B" & [B65000].End(xlUp).Row)
Rng.Sort Key1:=Range("B5"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
For Each c In Range("b5", [B65000].End(xlUp))
If Not d1.exists(c.Value) Then
d1(c.Value) = d1(c.Value) & " " & c.Offset(, -1)
Else
d1(c.Value) = d1(c.Value) & ";" & c.Offset(, -1)
End If
Next c
[E5].Resize(d1.Count, 1) = Application.Transpose(d1.keys)
[F5].Resize(d1.Count, 1) = Application.Trim(Application.Transpose(d1.items))
End Sub
P.