Sub test1()
Dim a, b(), i As Long, n As Long, maxCol As Integer, w()
Application.ScreenUpdating = False
With Sheets("Feuil1").Range("A1").CurrentRegion
a = .Value
ReDim b(1 To UBound(a, 1), 1 To UBound(a, 1) + 1)
With CreateObject("Scripting.Dictionary")
.CompareMode = 1
For i = 1 To UBound(a, 1)
If Not .exists(a(i, 1)) Then
n = n + 1
b(n, 1) = a(i, 1)
.Add a(i, 1), Array(n, 1)
End If
w = .Item(a(i, 1))
w(1) = w(1) + 1
b(w(0), w(1)) = a(i, 2)
maxCol = Application.Max(maxCol, w(1))
.Item(a(i, 1)) = w
Next
End With
'Résultat dans la même feuille
'Restitution et mise en forme
With .Offset(, .Columns.Count + 1).Resize(n, maxCol)
.CurrentRegion.Clear
.Cells(1).Resize(, 2).Value = [{"Marque","Modèle"}]
.Offset(1).Value = b
If maxCol > 2 Then
With .Cells(2)
.Value = "Modèle" & 1
.AutoFill .Resize(, maxCol - 1)
End With
End If
With .CurrentRegion
With .Rows(1)
.Font.Bold = True
.Interior.ColorIndex = 40
.BorderAround Weight:=xlThin
End With
.Font.Name = "calibri"
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
.Borders(xlInsideVertical).Weight = xlThin
.BorderAround Weight:=xlThin
End With
End With
End With
Application.ScreenUpdating = True
End Sub