Breaking One Row into Multiple Rows using VBA Macro?

[spqr]

Hi everyone!

I hope someone can help with this task I have. I am new to VBA and not sure if this is possible to accomplish with a macro.

I have an excel sheet that looks like this:

Rows 1 - 3 are general data that needs to be copied to a new sheet intact without changes.

Row 4 has the column names: A4 - H4 are the column headings of the MainOrder description.

Row 4 next has the column names: I4 - T4 are the column names of the SubOrder 1 (12 cells, always 12 cells per SubOrder)

Row 4 next has the column names: U4 - AF4 are the column headings of the SubOrder 2 (12 cells, always 12 cells per SubOrder)
... until it stops after 12th SubOrder 10 column, which is 12 cells DM4 - DX4

This column heading appears only once on the very top.

There are 10 SubOrders per one MainOrder, where MainOrder is always 8 columns long A-H, and each SubOrder is 12 columns long.

Row 5, 6, 7, 8, 9... etc. have MainOrder information and SubOrder information (10 with each 12 columns long)

Ideally the final sheet needs to have:

Rows 1 - 3 are general data that needs to be copied to a new sheet intact without changes.

The MainOrder column headings and the immediately following SubOrder 1 column headings need to be copied to a the final sheet once to provide the structure for the rest of the information

Loop Logic:

The actual data for MainOrder1 and SubOrder1 needs to be copied right under these column headings. However, while the MainOrder field needs to be only checked to see if the first cell in the row has word "Generated" in it (which if it does, it signifies the end of the data in the sheet and that last row with word "Generated" in the first cell needs to be copied over as the last row in the final sheet, and the entire process needs to stop)

Then, all SubOrders 1 - 10 with 12 column long each, need to be pasted under the column headings I4 - T4 that were copied and pasted from the original sheet earlier. This only happens to rows that don't have all 12 cells empty - if any of the 12 cells in an order have any data in it, then the entire 12 cell range needs to be pasted either under the I4 - T4 column headings or under previously copied offer that has at least one cell with data in it.

Once the loop has reached the last SubOrder in that row of the MainOrder, then it checks the next row's first cell in the original sheet to see if it has the word "Generated" in it. Which would mean it's the end of the process, and then this row with "Generated" needs to be copied into the final sheet's last row under the last SubOrder row and the process needs to end.

If the word "Generated" is not in the first cell of the next row in the original sheet, then the process needs to be repeated with the MainOrder2 information copied to the final sheet into the cells under the A4-H4 column headings, and then check for the 12 cells of the SubOrder 1 to see if any of the cells has data in it and once found one SubOrder that has at least one cell among the 12 of its cells, copy that SubOrder information under the column headings I4 - T4, then continue searching the next 12 cells in the same row, and then next 12, until the end of SubOrder 10 is reached.

Please ask questions if I didn't make it clear enough. I hope this helps you to help me.

Thank you!

 

[spqr]

I managed to put together a macro that I thought would do the sorting described above...

a.xls is the original sheet
Book1 is the magic sheet or the final sheet after the sorting is done

However, it is stopping right before the 'outer loop comment.

Please help gurus?


Sub Macro1()

Dim LC, a, rowcounter1, rowcounter2 As Long


Application.ScreenUpdating = False

rowcounter1 = 5
rowcounter2 = 5


'mindless copy of the first 4 rows
Windows("a.xls").Activate
Rows("1:3").Select
Selection.Copy
Windows("Book1").Activate
Rows("1:1").Select
ActiveSheet.Paste
Windows("a.xls").Activate
Application.CutCopyMode = False
Range("A4:T4").Select
Selection.Copy
Windows("Book1").Activate
Range("A4").Select
ActiveSheet.Paste
Application.CutCopyMode = False



'outer loop
Windows("a.xls").Activate

Do Until ActiveSheet.Range("A65536").End(xlUp).Row


Range(Cells(rowcounter1, 1), Cells(rowcounter1, 8)).Select
Selection.Copy

Windows("Book1").Activate

Windows("Book1").Copy Cells(rowcounter2, 1)


'inner loop
Windows("a.xls").Activate

LC = Cells(rowcounter1, Columns.Count).End(xlToLeft).Column
For a = 9 To LC Step 12

If (Range(Cells(rowcounter1, a), Cells(rowcounter1, a + 12)).Value <> "") Then

Range(Cells(rowcounter1, a), Cells(rowcounter1, a + 12)).Select

Selection.Copy


Windows("Book1").Activate

Windows("Book1").Copy Cells(rowcounter2, a)

'next row in the magic sheet
rowcounter2 = rowcounter2 + 1

End If

Next a

'next row in the original a sheet
rowcounter1 = rowcounter1 + 1

Loop

Application.ScreenUpdating = True
End Sub

 

[spqr]

Anyone has ideas? I appreciate your help!