Transposing Sets of Columns on Top of Each Other in Excel - 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: http://i.imgur.com/AagLIm8.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!

Answer 1

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

Answer 2

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