Stacking blocks of columns in Excel

Question

I would like to stack a multiple columns in blocks of ten. I saw this example where the stacking is done by pairs of two:

Stack multiple columns into two colums in pairs of two

Nonetheless, I have not succeeded in modifying it in such a way that columns are stacked in groups of ten.

The original data looks like this:

  A  B  C … J   K  L   M ... N T

1 1.1 1.2 1.3 … 1.10 1.1 1.2 1.3 … 1.10

2 2.1 2.2 2.3 … 2.10 2.1 2.2 2.3 … 2.10

3 3.1 3.2 3.3 … 3.10 3.1 3.2 3.3 … 3.10

4 4.1 4.2 4.3 … 4.10 4.1 4.2 4.3 … 4.10

5 5.1 5.2 5.3 … 5.10 5.1 5.2 5.3 … 5.10

6 6.1 6.2 6.3 … 6.10 6.1 6.2 6.3 … 6.10

7 7.1 7.2 7.3 … 7.10 7.1 7.2 7.3 … 7.10

8 8.1 8.2 8.3 … 8.10 8.1 8.2 8.3 … 8.10

What I would like to get is this:

A   B   C   …   J

1 1.1 1.2 1.3 … 1.10

2 2.1 2.2 2.3 … 2.10

3 3.1 3.2 3.3 … 3.10

4 4.1 4.2 4.3 … 4.10

5 5.1 5.2 5.3 … 5.10

6 6.1 6.2 6.3 … 6.10

7 7.1 7.2 7.3 … 7.10

8 8.1 8.2 8.3 … 8.10

9 1.1 1.2 1.3 … 1.10

10 2.1 2.2 2.3 … 2.10

11 3.1 3.2 3.3 … 3.10

12 4.1 4.2 4.3 … 4.10

13 5.1 5.2 5.3 … 5.10

14 6.1 6.2 6.3 … 6.10

15 7.1 7.2 7.3 … 7.10

16 8.1 8.2 8.3 … 8.10

Any hint on a how to do it with the macro mentioned above or another one?

Answer 1

Try this code, since it's just the one range you're trying to copy, K:T, you shouldn't have to do any sort of loops in it. Just a straight copy paste should work.

Sub MoveData()

    Dim ws      As Worksheet
    Dim lr      As Long
    Dim lc      As Integer

    Set ws = ThisWorkbook.Sheets(1)
    lc = ws.Range("XFD1").End(xlToLeft).Column '' Find the last column

    While lc <> 10 '' stop once it hits Column J
        lr = ws.Cells(1, lc).End(xlDown).Row '' Find the last row for this block of 10
        ws.Range(ws.Cells(1, lc).Offset(, -9), ws.Cells(lr, lc)).Copy ws.Range("A" & ws.Rows.Count).End(xlUp).Offset(1) '' Get the entire range for this block of 10, and copy it to the bottom column A
        ws.Range(ws.Cells(1, lc).Offset(, -9), ws.Cells(lr, lc)).ClearContents '' Clear it out
        lc = ws.Range("XFD1").End(xlToLeft).Column '' Get the last column again for the While loop
    Wend

End Sub