Próbáld ki:

Sub Átdarabol()
    Const sor = 64
    
    Dim wsSrc As Worksheet, wsDest As Worksheet
    Dim rng As Range, i As Long, s As Long, o As Long
    
    Set wsSrc = ActiveSheet
    Set wsDest = wsSrc.Parent.Worksheets.Add
    i = 0
    While wsSrc.Range("A" & (i * sor + 1)) <> ""
        Set rng = wsSrc.Range("A" & (i * sor + 1)).Resize(sor, 2)
        s = i \ 3 

        o = i Mod 3
        rng.Copy Destination:=wsDest.Cells(s * sor + 1, o * 3 + 1)
        i = i + 1
    Wend
    With wsDest.Range("C:C, F:F")
        .ColumnWidth = 3
        .Interior.ColorIndex = 15
    End With
    wsDest.Cells.EntireColumn.AutoFit
End Sub

A makró indításakor az a munkalap legyen aktív, ahol az átrendezendő adatok vannak.