Sub Regroupe2()
Set d = CreateObject("Scripting.Dictionary")
For Each c In Range("a2", [a65000].End(xlUp))
d(c.Value) = d(c.Value) & c.Offset(0, 1) & "|" & c.Offset(0, 2) & "|"
Next c
[G2].Resize(d.Count) = Application.Transpose(d.keys)
i = 2
For Each c In d.keys
a = Split(d(c), "|")
Cells(i, "h").Resize(, UBound(a)) = a
i = i + 1
Next c
End Sub