Transposer un tableau multicritères

Option Explicit

Sub test()
Dim myAreas As Areas, i As Long, n As Long
    On Error Resume Next
    Set myAreas = Sheets("Feuil1").Columns(2).SpecialCells(2).Areas
    On Error GoTo 0
    If myAreas Is Nothing Then Exit Sub
    n = 1
    With myAreas(1)
        myAreas(1).Offset(, -1).Copy
        Sheets("Feuil2").Cells(n, 1).PasteSpecial Transpose:=True
    End With
    For i = 1 To myAreas.Count
        n = n + 1
        myAreas(i).Copy
        Sheets("Feuil2").Cells(n, 1).PasteSpecial Transpose:=True
    Next
    Application.CutCopyMode = False
    Set myAreas = Nothing
End Sub