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 me

Answer 1

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

Answer 2

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