Sub Macro2_CopyPasteTRANSPOSE()
    Dim i As Long
    Dim x As Long: x = 6
    Dim LastRow As Long
    LastRow = Range("A" & Rows.Count).End(xlUp).Row
    Application.ScreenUpdating = False
    For i = 1 To LastRow Step 8
        Range("A" & i).Resize(6).Copy
        Range("B" & x).PasteSpecial xlPasteAll, , , Transpose:=True
        x = x + 3
    Next i
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub