Help Transposing every 2 Columns to Rows

[grantmcyorku]

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!

[#2]

@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

[#3]

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!

[#4]

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.

Thanks

Tauqeer

[#5]

@tauqeeracma it works fine. plz give the formula for multiple rows

[#6]

@prakashbabu250 

If on 365

=HSTACK(
    TOCOL(CHOOSECOLS(range, SEQUENCE(, COLUMNS(range) / 2, , 2))),
    TOCOL(CHOOSECOLS(range, SEQUENCE(, COLUMNS(range) / 2, 2, 2)))
)

[#7]

https://b23.tv/dmHs9Dg

How about this?

[#8]

Alternatively
=WRAPROWS(range, 2)