XL 2010 transformer un tableau pour aligner des données

Option Explicit
Sub test()
Dim a, b(), i As Long, n As Long, e
    a = Sheets("Feuil1").Range("b2").CurrentRegion.Value
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For i = 1 To UBound(a, 2)
            .Item(a(1, i)) = .Item(a(1, i)) + 1
        Next
        ReDim b(1 To Application.Max(.items) + 1, 1 To UBound(a, 2))
        For Each e In .keys
            For i = 1 To .Item(e)
                b(i + 1, n + 1) = a(2, i + n)
                b(1, i + n) = e
            Next
            n = n + .Item(e)
        Next
    End With
    'Restitution et mise en forme
    With Sheets("Feuil2").Range("a1").Resize(UBound(b, 1), UBound(b, 2))
        .Value = b
        .BorderAround Weight:=xlThin
        .Borders(xlInsideVertical).Weight = xlThin
        .Font.Name = "calibri"
        .Font.Size = 10
        .VerticalAlignment = xlCenter
        .HorizontalAlignment = xlCenter
        With .Rows(1)
            .WrapText = True
            .Font.Bold = True
            .BorderAround Weight:=xlThin
            .Interior.ColorIndex = 36
        End With
        .Columns.ColumnWidth = 11
        .Parent.Activate
    End With
End Sub

Option Explicit
Sub test()
Dim a, b(), w(), i As Long, n As Long, maxRow As Long
    a = Sheets("Feuil1").Range("b2").CurrentRegion.Value
    ReDim b(1 To UBound(a, 2) + 1, 1 To 1)
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For i = 1 To UBound(a, 2)
            If Not .exists(a(1, i)) Then
                n = n + 1
                If n > UBound(b, 2) Then
                    ReDim Preserve b(1 To UBound(b, 1), 1 To n)
                End If
                b(1, n) = a(1, i)
                .Item(a(1, i)) = VBA.Array(1, n)
            End If
            w = .Item(a(1, i))
            w(0) = w(0) + 1
            b(w(0), w(1)) = a(2, i)
            maxRow = Application.Max(maxRow, w(0))
            .Item(a(1, i)) = w
        Next
    End With
    Application.ScreenUpdating = False
    'Restitution et mise en forme
    With Sheets("Feuil2")
        .Cells.Clear
        With .Range("a1").Resize(maxRow, UBound(b, 2))
            .Value = b
            .Font.Name = "calibri"
            .Font.Size = 10
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .BorderAround Weight:=xlThin
            .Borders(xlInsideVertical).Weight = xlThin
            With .Rows(1)
                .WrapText = True
                .RowHeight = 30
                .Interior.ColorIndex = 42
                .BorderAround Weight:=xlThin
            End With
            .Columns.ColumnWidth = 11
        End With
        .Activate
    End With
    Application.ScreenUpdating = True
End Sub