Excel VBA, copy 8 columns of data, paste "stacked" into 4 colums

[Tomkat]

Tomkat 04:44 PM Today
So basically I have data arragned like...

1,2,3,4,5,6,7,8
1,2,3,4,5,6,7,8
1,2,3,4,5,6,7,8
........

**NOTE** The source range is dynamic, not static, so although it is always 8 columns, it can be any number of rows.
I'm using Selection.End(xlDown), etc to copy the source range to account for this.

Then I want to copy/paste/re-arrange via macro so that the paste destination looks like...

1,2,3,4
5,6,7,8
1,2,3,4
5,6,7,8
1,2,3,4
5,6,7,8
....
....

I know I should be able to do this, and I've searched for the answer, but I think I'm not describing my issue with the correct terms.
Can anyone please help me?

[June7]

I assume every row does not really have values of 1,2,3,4,5,6,7,8? Is there a column that can serve as a record ID? Is there a header row?

Perhaps you should post real data or provide worksheet. See instructions at bottom of my post.

Here is one approach:

Sub Macro1() Dim x As Integer
Columns("A:A").Insert Shift:=xlToRight ', CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").FormulaR1C1 = "1"
Range("A1").AutoFill Destination:=Range("A1:A" & Cells(Rows.Count, 2).End(xlUp).Row), Type:=xlFillSeries
Rows(1).Insert Shift:=xlDown ', CopyOrigin:=xlFormatFromLeftOrAbove
For x = 1 To 9
Cells(1, x).Value = Chr(65 - 1 + x)
Next

Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adCmdText = &H1
Dim cn As Object, rS As Object
Set cn = CreateObject("ADODB.Connection")
Set rS = CreateObject("ADODB.Recordset")

cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & ThisWorkbook.FullName & ";" & _
"Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1;TypeGuessRows=0;ImportMixedTypes=Text"""

rS.Open "SELECT [A],1 AS Seq,[B],[C],[D],[E] FROM [Sheet1$] " & _
"UNION SELECT [A],2,[F],[G],[H],[I] FROM [Sheet1$]", cn, adOpenStatic, adLockOptimistic, adCmdText
Sheet1.Range("K2").CopyFromRecordset rS

End Sub

[snb]

Sub M_snb()
sn = Cells(1).CurrentRegion
ReDim sp(2 * UBound(sn), UBound(sn, 2) \ 2)

For j = 1 To UBound(sn)
For jjj = 0 To 1
For jj = 1 To UBound(sp, 2)
sp(n, jj - 1) = sn(j, jj + jjj * UBound(sp, 2))
Next
n = n + 1
Next
Next

Cells(10, 1).Resize(UBound(sp) + 1, UBound(sp, 2) + 1) = sp
End Sub

[snb]

Sub M_snb()
sn = Cells(1).CurrentRegion
ReDim sp(2 * UBound(sn), UBound(sn, 2) \ 2)

For j = 1 To UBound(sn)
For jjj = 0 To 1
For jj = 1 To UBound(sp, 2)
sp(n, jj - 1) = sn(j, jj + jjj * UBound(sp, 2))
Next
n = n + 1
Next
Next

Cells(10, 1).Resize(UBound(sp) + 1, UBound(sp, 2) + 1) = sp
End Sub

Or in Excel:

in A30 : D36


=INDEX($A$1:$H$3;INT((ROW(A1)-1)/2)+1;COLUMN(A1)+4*MOD(ROW(A1)-1;2))

[georgiboy]

If you have Excel 365 then..

Formula:
=WRAPROWS(TOCOL(A1:H3),4)

VBA:

Sub test()
Dim var As Variant, rng As Range

With Sheet1
Set rng = Sheet1.Range("A1:H" & Sheet1.Range("A" & Rows.Count).End(xlUp).Row)
var = Evaluate("WRAPROWS(TOCOL(" & rng.Address(, , , 1) & "),4)")
.Range("K1").Resize(UBound(var), 4) = var
End With
End Sub