Private Sub CommandButton1_Click()
Dim D As Object, Plg As Range, Cel As Range, Temp As Variant, L&, i&
Application.ScreenUpdating = False
L = 1
Set D = CreateObject("Scripting.Dictionary")
With Sheets("Feuil1")
Set Plg = .Range(.Cells(3, 1), .Cells(Rows.Count, 1).End(xlUp))
For Each Cel In Plg
If Not D.Exists(Cel.Value) Then
L = L + 1
Temp = .Range(Cel.Address, Cel.Offset(0, 3).Address).Value
Cells(L, Columns.Count).End(xlToLeft).Offset(0, 1).Resize(1, 4) = Temp
D(Cel.Value) = L
Else
Temp = .Range(Cel.Offset(0, 1).Address, Cel.Offset(0, 3).Address).Value
Cells(D(Cel.Value), Columns.Count).End(xlToLeft).Offset(0, 1).Resize(1, 3) = Temp
End If
Next Cel
End With
Application.ScreenUpdating = True
End Sub