Help Transposing every 2 Columns to Rows

New Contributor

Hoping someone can help me out.  I'm looking for an automated way to transpose every 2 columns to rows.  

I want to go from this:

Screen Shot 2021-12-23 at 1.25.56 PM.png

To this:

Screen Shot 2021-12-23 at 1.27.09 PM.png



3 Replies


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
Thanks. Hans Vogelaar. That didn't quite work for me, but got me looking into creating my own macros for the first time, and I now have it working.

Hi @grantmcyorku 


You may use the below formula based variant to transpose columns to rows:


Formula for Column_1 >>>>    =OFFSET($D$2:$S$2,0,((ROW(B5)-ROW($B$5))*2),1,1)

Formula for Column_2 >>>>    =OFFSET($D$2:$S$2,0,1+((ROW(C5)-ROW($C$5))*2),1,1)



A sample file is also attached for your reference.


Please let me know if it works for you.