VB to move data from 1 row down to multiple rows

[Andy16H]

I have a sheet that has data only in row 1. It stretches all the way to column ANN. I need to copy and segment this data going down. Every 8 columns have the same type of data.
Example
My data looks like this
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32.........

I need it to look like this
1 2 3 4 5 6 7 8
9 10 11 12 13 14 15 16
17 18 19 20 21 22 23 24
25 26 27 28 29 30 31 32
........
........
........

 

[rallcorn]

Sub DataToNewRow()
Dim c As Long, LastCol As Long
Dim CopyRng As Range
LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
For c = 9 To LastCol Step 8
    Set CopyRng = Range(Cells(1, c), Cells(1, c + 7))
    CopyRng.Copy Destination:=Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1)
    Application.CutCopyMode = False
    CopyRng.ClearContents
Next c
End Sub

 

[rallcorn]

Assumes data began in A1.

 

[Andy16H]

Worked Great
Thank you

 

[rallcorn]

You're welcome. Happy to help.

 

[hiker95]

Andy16H,

With your raw data in worksheet Sheet1, beginning in cell A1.

The following macro is very fast because of the use of arrays in memory - macro execution time was 0.000 seconds.

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Option Explicit
Sub ReorgData()
' hiker95, 04/08/2013
' http://www.mrexcel.com/forum/excel-questions/695902-vbulletin-move-data-1-row-down-multiple-rows.html
Dim a As Variant, b As Variant
Dim i As Long, ii As Long
With Sheets("Sheet1")
  a = .Cells(1).CurrentRegion
  ReDim b(1 To (UBound(a, 2) / 8) + 10, 1 To 8)
  On Error Resume Next
  For i = 1 To UBound(a, 2) Step 8
    ii = ii + 1
    b(ii, 1) = a(1, i)
    b(ii, 2) = a(1, i + 1)
    b(ii, 3) = a(1, i + 2)
    b(ii, 4) = a(1, i + 3)
    b(ii, 5) = a(1, i + 4)
    b(ii, 6) = a(1, i + 6)
    b(ii, 7) = a(1, i + 7)
  Next i
  On Error GoTo 0
  .Rows(1).ClearContents
  .Cells(1).Resize(UBound(b, 1), UBound(b, 2)) = b
End With
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the ReorgData macro.