Transposing Sets of Columns on Top of Each Other in Excel

Question

So I have multiple sets of 3 columns. Each set is always in the same column order ("SKU", "Sales". "Date".)

I am wondering is there is a VBA script or other method that would do the following:

1.) Copy G:I

2.) Paste into A:C

3.) Copy J:L

4.) Paste into A:C (Underneath G:I's data)

5.) Copy M:O

6.) Paste into A:C (underneath J:L's data)

7.) Repeat (I would like it to repeat every 3 columns forever, but if that's not possible I'll manually input the columns if I have
to.)

This is a visual of what I'm looking for: https://i.stack.imgur.com/2JF4O.png

I also uploaded the workbook in case you need it for reference: https://www.dropbox.com/s/wea2nr4xbfo4934/Workbook.xlsx?dl=0

Thanks for the help!

What have you tried? This is certainly possible. I suggest starting with the Macro Recorder and doing this a few times. Then you'll have some basic code to start out with. Then, [remove `.Select`/`.Activate` from that](https://stackoverflow.com/questions/10714251) and use variables. Then look up loops in VBA. Finally, where you say "...like it to repeat every 3 columns forever...", what do you mean? Do that for every three columns until your info runs out? Or literally until the very last column in Excel's worksheet? — BruceWayne, Jul 24 '17 at 19:46
To better explain the "repeating" thing, I am running reports every week, so every week 3 more columns will be added onto the right side of those columns (so for this spreadsheet, P:R will have data in them next time I run a report.) I am looking for a script that accounts for the fact that more and more sets of columns will be added in the future. — ChillAnon, Jul 24 '17 at 20:00
I found a script that works perfectly on another spreadsheet, but I'm having trouble modifying it for my worksheet: http://prntscr.com/fzrlk9 — ChillAnon, Jul 24 '17 at 20:03

score 1 · Accepted Answer · answered Jul 24 '17 at 20:39

The code below does what you want, and I've included some ".select" lines to help you understand. I suggest you step through it to become clear, as in the animated gif. Then, remove all the ".select" lines of code.

Option Explicit
Sub moveData()
Dim rSource As Range, rDest As Range, r As Range
Dim tbl As Range, rowNum As Integer
Const colNum = 3

Set rDest = Range("A1")
Set rSource = Range("G1")
Set r = rSource
While r <> ""
    Set r = Range(r, r.End(xlDown))
    Set tbl = Range(r, r.Offset(0, colNum - 1))
    tbl.Select
    Set tbl = Range(tbl, tbl.End(xlDown).Offset(1, 0))
    tbl.Select
    tbl.Copy
    rDest.Select
    rDest.PasteSpecial (xlPasteAll)
    Set rDest = rDest.Offset(tbl.Rows.Count, 0)
    Set r = r(1, 1)
    r.Select
    Set r = r.Offset(0, colNum)
    r.Select
Wend
End Sub

Thanks Tony! This ended up being a faster option, which is why I used it. — ChillAnon, Jul 25 '17 at 15:01
To be honest, this was just a "quick and dirty" solution and was not optimized at all for speed. In fact, my point was really to show techniques for solving problems like this so that you could apply them to your own revisions, and that's why I put in all the select statements. What you "get it" you can do a lot with VBA. — Tony M, Jul 25 '17 at 15:16

RMH · Answer 2 · 2017-07-24T20:42:38.953

try to do this:

Sub CopyColumns()

    Dim actualRow As Integer
    Dim actualColumn As Integer

    Dim rowFrom As Integer
    Dim myColumns As Integer
    Dim startColumn As Integer

    myColumns = 3 'the number of columns before start repeating (in your case is SKU, Sales, Date, so there are 3 columns)
    startColumn = 7 'the column where start de data. In your example is the Column G

    actualRow = 1
    actualColumn = 1

    rowFrom = 1

    Dim eoRows As Boolean

    eoRows = False

    While eoRows = False

        'verify if there's no more data
        If Cells(rowFrom, startColumn) = "" Then
            eoRows = True
        Else
            'verify if there's no more row
            While Cells(rowFrom, startColumn) <> ""
                For i = startColumn To startColumn + myColumns - 1
                    Cells(actualRow, actualColumn) = Cells(rowFrom, i)
                    actualColumn = actualColumn + 1
                Next

                rowFrom = rowFrom + 1
                actualRow = actualRow + 1
                actualColumn = 1

            Wend
            rowFrom = 1
            startColumn = startColumn + myColumns

        End If


    Wend

End Sub

Okay, after testing it on my more complex worksheet (it has a lot more rows in each column than the test one I submitted here,) I noticed that it takes 15-20 minutes to run, even on our faster office computer. Any way to fix that? — ChillAnon, Jul 25 '17 at 14:52
No man, the other anwser already solve your issue. It is the best one. There are some commands there that I didn't know. — RMH, Jul 25 '17 at 18:42

Transposing Sets of Columns on Top of Each Other in Excel

2 Answers2

Linked