Arrange horizontal data to vertical through cut, paste, loop

Please attach a workbook, showing clearly what your current structure looks like, and what your required outcome looks like. Please be clear about the required sort order of the final data, as there will be more than one way of looping through and transferring data to columns...

Are you really happy leaving A:D blank? Would it not be better to include the correct values in A:D for every row?

Is the order of the outcome essential (ie - reverse column order)? Because while it's possible to loop through the way you describe, it's probably more efficient to cut and paste larger blocks of text at a time.

Okay. Here's a loop of code that does exactly what you initially asked for, but a bit slowly:

Sub Foo()
Dim lRow As Long, lCol As Long, lColMax As Long
Application.ScreenUpdating = False
With Sheet1
    lColMax = .Cells(2, Columns.Count).End(xlToLeft).Column
    For lRow = .Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
        For lCol = lColMax - 3 To 9 Step -4
            .Cells(lRow, lCol).Resize(1, 4).Cut .Cells(1, 5).End(xlDown).Offset(1, 0)
        Next lCol
        If lRow > 2 Then .Cells(lRow, 5).Resize((lColMax - 8) / 4, 1).EntireRow.Insert
    Next lRow
    .Range(Cells(1, 9), Cells(1, lColMax)).Clear
End With
Application.ScreenUpdating = True
End Sub

Now here's another better solution, which works much faster, and includes data in A:D:

Sub Bar()
Dim lRows As Long, lCol As Long, lColMax As Long
Application.ScreenUpdating = False
With Sheet1
    lColMax = .Cells(2, Columns.Count).End(xlToLeft).Column
    lRows = .Cells(Rows.Count, 1).End(xlUp).Row - 1
    For lCol = lColMax - 3 To 9 Step -4
        .Cells(2, 1).Resize(lRows, 4).Copy .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
        .Cells(2, lCol).Resize(lRows, 4).Cut .Cells(Rows.Count, 5).End(xlUp).Offset(1, 0)
    Next lCol
    .Range(Cells(1, 9), Cells(1, lColMax)).Clear
End With
Application.ScreenUpdating = True
End Sub

Originally Posted by kcheeser

Thanks, but I get a run-time error:

Method 'Range' of object'_Worksheet' failed.

Which subroutine, which line? Are you trying it on the workbook "original data"?

Last line?

Application.Screenupdating = True

??

No idea. I can't replicate your error.

The code worked perfectly on my XL2010 machine when I wrote it this afternoon, and is working perfectly on my XL2013 machine now: Just downloaded your "original data" file, pasted the 'bar' code into a new module, and it ran perfectly.

There should be no fiddling needed. Apply that code to the workbook you uploaded, and it should work with no issues. Unless you've changed something.

Odd. I've asked if others can take a look, see if they get the same error and / or if I'm missing something!

Please upload the wb with the code already in place.

Both macros run w/2007

Originally Posted by protonLeah

Both macros run w/2007

Thanks for testing

Glad it's working for you now, kcheeser. Now, see if you can understand how the code actually works, so you can adapt it as and when necessary!

If Sheet1 is not active sheet that code will fail. It is better to write:

    .Range(.Cells(1, 9), .Cells(1, lColMax)).Clear

Originally Posted by Izandol

If Sheet1 is not active sheet that code will fail. It is better to write:

    .Range(.Cells(1, 9), .Cells(1, lColMax)).Clear

THAT'S what I was missing. Oops!

Thanks, Izandol.