Matrice carré à partir de n lignes*3colonnes

Sub Essai()
Dim a, i As Long, AL As Object, e
    Application.ScreenUpdating = False
    Set AL = CreateObject("System.Collections.ArrayList")
    With Range("A1").CurrentRegion
        a = .Value
        With CreateObject("Scripting.Dictionary")
            .CompareMode = 1
            For i = 2 To UBound(a, 1)
                If Not AL.Contains(a(i, 2)) Then AL.Add a(i, 2)
                If Not .exists(a(i, 1)) Then
                    Set .Item(a(i, 1)) = _
                    CreateObject("Scripting.Dictionary")
                End If
                .Item(a(i, 1))(a(i, 2)) = a(i, 3)
            Next
            AL.Sort
            ReDim a(1 To .Count + 1, 1 To AL.Count + 1)
            For i = 0 To AL.Count - 1
                a(1, i + 2) = AL(i)
            Next
            For i = 0 To .Count - 1
                a(i + 2, 1) = .keys()(i)
                For Each e In .items()(i).keys
                    a(i + 2, AL.IndexOf(e, 0) + 2) = IIf(.items()(i)(e) <> 0, .items()(i)(e), "")
                Next
            Next
        End With
        'Résultat sur la même feuille
        With .Offset(, .Columns.Count + 3).Resize(UBound(a, 1), UBound(a, 2))
            .CurrentRegion.Clear
            .Value = a
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .BorderAround ColorIndex:=1, Weight:=xlThin
            .Borders(xlInsideVertical).Weight = xlThin
            .Rows(1).Offset(, 1).Resize(, .Columns.Count - 1).Interior.ColorIndex = 40
            .Rows(1).BorderAround ColorIndex:=1, Weight:=xlThin
            .Columns(1).Offset(1).Resize(.Rows.Count - 1).Interior.ColorIndex = 19
        End With
    End With
    Application.ScreenUpdating = True
End Sub