 Help Transposing every 2 Columns to Rows

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: To this: Thanks!

3 Replies

Re: Help Transposing every 2 Columns to Rows

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

Re: Help Transposing every 2 Columns to Rows

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.
Cheers!

Re: Help Transposing every 2 Columns to Rows

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.

Thanks

Tauqeer