Sub transposer()
Dim Source As Range, t, i&, n&, j&, ref As String
Application.ScreenUpdating = False
With Worksheets("Données_Initial")
If .FilterMode Then .ShowAllData
Set Source = .Range("a1:b" & .Cells(Rows.Count, "a").End(xlUp).Row)
Source.Sort key1:=.Range("a1"), order1:=xlAscending, key2:=.Range("b1"), order2:=xlAscending, Header:=xlYes, MatchCase:=False
t = Source.Resize(Source.Rows.Count + 1)
End With
With Worksheets("Resultat")
.Rows("2:" & Rows.Count).Clear
n = 1: ReDim r(1 To Columns.Count): r(1) = t(2, 1): r(2) = t(2, 2): j = 2
For i = 3 To UBound(t)
If t(i, 1) = r(1) Then
j = j + 1: r(j) = t(i, 2)
Else
n = n + 1
.Cells(n, "a").Resize(, j) = r
r(1) = t(i, 1): r(2) = t(i, 2): j = 2
End If
Next i
.Select
End With
End Sub