excel - Copy every two cells and transpose

I am trying to transpose every next two cells and paste them in next right cells.

I have a table as shown in the screenshot:

I want to copy range "B2:B3" and transpose this to "C2" and then loop until there is some data in column B. (so select and copy next "B4:B5" and transpose this to "B4").

I cannot get this to transpose in the right place and then loop.

I have something like this (I did not add loop yet to this macro):

Sub Macro1()
    Dim a As Long, b As Long
    a = ActiveCell.Column
    b = ActiveCell.Row


    Range("B2").Select
    Range(ActiveCell, Cells(b + 1, a)).Select
    Selection.Copy
End Sub

Answer

a VBA solution

Option Explicit


Sub main()
    Dim pasteRng As Range
    Dim i As Long

    With ActiveSheet
        Set pasteRng = .Range("C1:D2")
        With .Range("B2:B" & .Cells(.Rows.count, "B").End(xlUp).Row)
            For i = 1 To .Rows.count Step 2
                pasteRng.Offset(i).Value = Application.Transpose(.Cells(i, 1).Resize(2))

            Next i
        End With
    End With
End Sub