Loop, Copy and Transpose

Try

Sub Transposer()
Dim Lr As Long, i As Long
Lr = Cells(Rows.Count, "B").End(xlUp).Row

Application.ScreenUpdating = False
    For i = 3 To Lr Step 4
        Range("B" & i, "B" & i + 3).Copy
        Range("H65536").End(xlUp).Offset(1). _
        PasteSpecial Transpose:=True
    Next i
    
With Application
    .CutCopyMode = False
    .ScreenUpdating = True
End With

End Sub

VBA Noob