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