Transpose data from rows to columns - with a slight twist

this will work

Sub abc()
 Const shSource As String = "Source"  '<==== Change for your needs
 Const shTarget As String = "Target"  '<==== Change for your needs
 
 Dim CellPtr As Long, DestRow As Long
 
 DestRow = 1
 With Worksheets(shSource)
    For CellPtr = 1 To .Cells(Rows.Count, "a").End(xlUp).Row Step 3
       a = .Range(.Cells(CellPtr, "a"), .Cells(CellPtr + 2, "a"))
       With Worksheets(shTarget)
            .Cells(DestRow, "a").Resize(, UBound(a)) = Application.Transpose(a)
       End With
       DestRow = DestRow + 1
    Next
 End With
End Sub