Dividindo uma linha com várias colunas em várias linhas

Question

Então eu peguei este código VBA ...

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

Eu tenho o seguinte cenário abaixo e não consigo que a macro funcione sem problemas (como não estou acostumado a codificar em nada). Tenho tentado descobrir o código acima, mas isso não faz sentido em como as colunas funcionam nessa ordem. Alguém pode ajudar por favor?

Eu tenho esses dados

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

Eu preciso ter as colunas seguidas da seguinte forma:

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

Alguém pode ajudar com isso?

    

Answer 1

Então, ao invés de tentar fazer matemática, vamos apenas dar um passo a cada 2 nas colunas que começam com a terceira coluna. Isso torna a matemática um pouco mais simples:

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