Sub Regrouper()
Dim plage As Range, tablo, ncol%, d As Object, i&, t$(), j%
Set plage = Sheets("Données").UsedRange
If plage.Count = 1 Then Exit Sub 'sécurité
plage.Sort plage(1), xlAscending, Header:=xlYes 'tri avec en-têtes
tablo = plage.Resize(Application.Count(plage.Columns(1)) + 2).Value2
ncol = UBound(tablo, 2)
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(tablo) - 1
If Not d.exists(tablo(i, 1)) Then
d(tablo(i, 1)) = ""
ReDim t(1 To ncol) 'RAZ
End If
For j = 1 To ncol
If tablo(i, j) <> "" Then t(j) = tablo(i, j)
Next
If Not d.exists(tablo(i + 1, 1)) Then d(tablo(i, 1)) = Join(t, Chr(1))
Next
'---restitution---
With Sheets("Résultats")
.Cells.ClearContents
.[A1].Resize(d.Count) = Application.Transpose(d.items)
Application.DisplayAlerts = False
.[A:A].TextToColumns .[A1], xlDelimited, Other:=True, OtherChar:=Chr(1)
.Activate
End With
End Sub