I need to re-arrange 3500 horizontal cells that are in 1 row into 500 rows each with 7 cells (many times a day so can it be "automated"?)

[datadatadatadata2]

[FONT=&quot]I have this data: Imgur: The most awesome images on the Internet and so on… (up to 500 sets of data each with 7 cells, and the first cell being the set's number 1-500; so 3500 (500*7) horizontal cells in total)[/FONT]
[FONT=&quot]What I need to do is to get each set of data (7 cells) to stack up on top of each other. As shown below: Imgur: The most awesome images on the Internet[/FONT]
[FONT=&quot]I can do this manually and it takes around 10-15 minutes. But I need to do this exact same thing many many times during the next 9 days. So, my question is: is there any VBA code or something else that could automatically do this "re-arrangement" in this situation?[/FONT]
[FONT=&quot]I guess I should have taken the optional VBA class in my finance degree :P[/FONT]
[FONT=&quot]Thank you very much for you help!!!!!!!![/FONT]

 

[Fluff]

Hi & welcome to MrExcel
Does this what you need?

Sub RearrangeRw()
' datadata (ZZ1)

    Dim UsdCols As Long
    Dim Rw As Long
    Dim Col As Long
    
    UsdCols = Cells(1, Columns.Count).End(xlToLeft).Column
    Rw = 2
    For Col = 8 To UsdCols Step 7
        Cells(1, Col).Resize(, 7).Copy Cells(Rw, 1)
        Rw = Rw + 1
    Next Col

End Sub

 

[tonyyy]

data...2,

Welcome to the Board.

Another vba approach...

Sub RearrangeRow_1020976()
Dim arr1 As Variant, arr2 As Variant
Dim LastColumn As Long, Rowz As Long, i As Long, j As Long, k As Long, result As Long
LastColumn = Cells(1, Columns.Count).End(xlToLeft).Column
Rowz = LastColumn / 7
result = LastColumn Mod 7
If result = 0 Then
    Rowz = Rowz
Else
    Rowz = Rowz + 1
End If
arr1 = Range(Cells(1, 1), Cells(1, LastColumn))
ReDim arr2(1 To Rowz, 1 To 7)
i = 1
j = 1
Do Until i = LastColumn
    For k = 1 To 7
        arr2(j, k) = arr1(1, i)
        If i < LastColumn Then
            i = i + 1
        Else
            GoTo finish
        End If
    Next k
    j = j + 1
Loop
finish:
    Rows(1).Delete
    Range(Cells(1, 1), Cells(Rowz, 7)) = arr2
End Sub

Cheers,

tonyyy