Splitting one Row with Multiple Columns into Multiple Rows

Question

So I picked up this VBA code ...

Sub NewLayout()
    For i = 2 To Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
        For j = 0 To 2
        If Cells(i, 3 + j) <> vbNullString Then
            intCount = intCount + 1
            Cells(i, 1).Copy Destination:=Cells(intCount, 10)
            Cells(i, 2).Copy Destination:=Cells(intCount, 11)
            Cells(i, 3 + j).Copy Destination:=Cells(intCount, 12)
            Cells(i, 6 + j).Copy Destination:=Cells(intCount, 13)
        End If
        Next j
    Next i
End Sub

I have the following below scenario and don’t get the macro to work smoothly (as I am not used to coding in anything). I have been trying to figure the above code, but it just doesn’t make sense as to how the columns work in that order. Can anyone please assist?

I have this data

Company  Code      Store1   Store Hours1    Store2   Store Hours2    Store3   Store Hours3
90       920016    BAY0     40              BCR0     35              BES0     20
90       920052    BAY0     40              BCR0     35              BES0     20
90       920054    BAY0     40              BCR0     35              BES0     20
90       920058    BAY0     40              BCR0     35              BES0     20

I need to have the columns in a row as follows:

90       920016    BAY0    40
90       920016    BCR0    35
90       920016    BES0    20
90       920052    BAY0    40
90       920052    BCR0    35
90       920052    BES0    20
90       920054    BAY0    40
90       920054    BCR0    35
90       920054    BES0    20

Can anyone perhaps help with this?

score 0 · Answer 1 · answered Jun 20 '16 at 23:54

So instead of trying to do math, lets just step every 2 on the columns starting with the third column. This makes the math a little simpler:

Sub NewLayout()
Dim ws As Worksheet
Dim i As Long, j As Long
Dim intCount As Long

For i = 2 To Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
    For j = 3 To 7 Step 2
        If Cells(i, j) <> vbNullString Then
            intCount = intCount + 1
            Cells(i, 1).Copy Destination:=Cells(intCount, 10)
            Cells(i, 2).Copy Destination:=Cells(intCount, 11)
            Cells(i, j).Copy Destination:=Cells(intCount, 12)
            Cells(i, j + 1).Copy Destination:=Cells(intCount, 13)
        End If
    Next j
Next i
End Sub

Splitting one Row with Multiple Columns into Multiple Rows

1 Answers1

Linked