複数の列を持つ 1 つの行を複数の行に分割する

Question

そこで私はこの 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

次のようなシナリオがありますが、マクロがスムーズに動作しません (コーディングに慣れていないため)。上記のコードを理解しようとしましたが、列がその順序でどのように機能するのかまったく理解できません。どなたか助けていただけませんか?

このデータを持っています

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

次のように列を一列に並べる必要があります。

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

誰かこれについて助けてくれませんか?

Answer 1

したがって、計算する代わりに、3 列目から始めて、列を 2 ずつ進めてみましょう。これにより、計算が少し簡単になります。

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