Excel VBA 多重ループについて

Dim ws2 As Object
Set ws2 = Worksheets("Sheet2")
Dim ws As Object
Set ws = Worksheets("Sheet1")

With ActiveCell

Z = 1
For a = ActiveCell.Row To ActiveCell.Row + 56 Step 5
For b = ActiveCell.Row + 3 To ActiveCell.Row + 56 Step 5
For c = 2 To 13

If Range("C1") = .Offset(a, -2) Then
Z = Z + 1
Range(.Offset(b, 1), .Offset(b, 18)).Copy ws2.Cells(c, 4)
ws.Select

End If

Next c
Next b
Next a

End With


↑のコードを自分なりに考えましたがダメでした。
多分、変なコードを記載していると思います。
セルC1とActiveセルの２つとなりが、一致したら、Sheet２へ転記するというのを繰り返したいのです。
とこがおかしいのか、お手数ですが、ご教示していただければ、幸いです。

どうそ、よろしくお願いします。

No.1 ベストアンサー 回答者： よろずやkinchan 回答日時： 2020/02/15 13:03

Option Explicit

Sub test()
Dim ws2 As Object
Set ws2 = Worksheets("Sheet2")
Dim ws As Object
Set ws = Worksheets("Sheet1")
Dim a As Long, b As Long, c As Long
With ActiveCell

'Z = 1
For a = ActiveCell.Row To ActiveCell.Row + 56 Step 5
b = a + 3 'For b = ActiveCell.Row + 3 To ActiveCell.Row + 56 Step 5
c = 2 'For c = 2 To 13

If Range("C1") = .Offset(a, -2) Then
'Z = Z + 1
Range(.Offset(b, 1), .Offset(b, 18)).Copy ws2.Cells(c, 4)
'ws.Select
c = c + 1
End If

'Next c
'Next b
Next a

End With
End Sub

んな感じ。

この回答へのお礼

こうのように書くのですね。
大変参考になりました。
ありがとうございました。

お礼日時：2020/02/15 14:01