Sub Classer()
Dim tablo, d As Object, i&, t$, a, b, cc%, s
tablo = Range("B1", Range("E" & Rows.Count).End(xlUp))
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(tablo)
t = tablo(i, 4)
d(t) = d(t) & Chr(1) & tablo(i, 1) & " " & tablo(i, 2) & " " & tablo(i, 3)
Next
a = d.keys: b = d.items
'---restitution---
Application.ScreenUpdating = False
cc = Columns.Count
Range(Columns(7), Columns(cc)).ClearContents 'RAZ
For i = 0 To UBound(a)
If i + 7 > cc Then MsgBox "Feuille insuffisante...": Exit Sub
[G1].Offset(, i) = a(i)
s = Split(Mid(b(i), 2), Chr(1))
[G2].Offset(, i).Resize(UBound(s) + 1) = Application.Transpose(s)
Next
End Sub