ListeA()
Dim T, TT(1 To 7), i As Long, j As Byte
Dim WS As Worksheet, WD As Worksheet, Dico
Set WS = Worksheets("SORTIES")
Set WD = Worksheets("DONNEES")
Set Dico = CreateObject("Scripting.Dictionary")
T = WS.Range("H1:Q" & WS.Range("H" & Rows.Count).End(xlUp).Row)
For i = LBound(T, 1) To UBound(T, 1)
If Not Dico.Exists(T(i, 1)) Then
TT(1) = T(i, 2)
For j = 2 To 7
TT(j) = T(i, j + 3)
Next
Dico(T(i, 1)) = TT
End If
Next
WD.Range("A1").Resize(Dico.Count, 1) = Application.Transpose(Dico.keys)
WD.Range("B1").Resize(Dico.Count, 7) = Application.Transpose(Application.Transpose(Dico.items))
WD.UsedRange.Sort Key1:=WD.Range("A2"), Order1:=xlAscending, Header:=xlGuess
End Sub