Help Transposing every 2 Columns to Rows

grantmcyorku 

Run this macro:

Sub Transform()
    Dim r As Long
    Dim c As Long
    Dim n As Long
    Application.ScreenUpdating = False
    n = Cells(1, Columns.Count).End(xlToLeft).Column
    For c = 1 To n Step 2
        r = r + 1
        Cells(1, c).Copy Destination:=Cells(r, 1)
        r = r + 1
        Cells(1, c + 1).Copy Destination:=Cells(r, 1)
    Next c
    Cells(1, 2).Resize(1, n - 1).Clear
    Application.ScreenUpdating = True
End Sub