エクセルVBA 1行飛ばしで転記するループ処理

教えてください。
シートのデータを1行飛ばしで
別のシートに転記したいのです。
ただし、別のシートには4行飛ばしで転記したいのですが
どのように書けばよいのでしょうか？
よろしくお願いします。

No.2 回答者： fujillin 回答日時： 2018/01/12 17:12

#1です。

再度見たら、コピー範囲の判断部分にミスがあることに気が付きました。
申し訳ありませんが、訂正しておきます。m(__)m


誤　 While sRange.Row < maxRow
　　　　↓　↓　↓
正　 While sRange.Row <= maxRow

（もとのままだと、最後の行が対象に該当してもコピーされないですね）

No.1 回答者： fujillin 回答日時： 2018/01/11 17:15

こんにちは

元シートの1行目を別シートの1行目に、3行目を6行目に、5行目を11行目に・・・
という意味で良いのでしょうか？

まぁ、2行目から始めるとかいろいろありそうな気がしますので、調整しやすい以下のような方法ではいかがでしょうか？

Sub Sample()

Dim sRange As Range, dRange As Range
Dim maxRow As Long

Const sStep = 2 '元シートの飛ばす行+1
Const dStep = 5 'コピー先の飛ばす行+1

'コピー元の最初の対象となる行
Set sRange = Worksheets("Sheet1").Rows(1)

'コピー先の最初の対象となる行
Set dRange = Worksheets("Sheet2").Rows(1)

'コピー元の最終行を取得（仮にA列）
maxRow = sRange.Worksheet.Cells(Rows.Count, 1).End(xlUp).Row

While sRange.Row < maxRow
　sRange.Copy Destination:=dRange
　Set sRange = sRange.Offset(sStep, 0)
　Set dRange = dRange.Offset(dStep, 0)
Wend

End Sub

この回答へのお礼

ありがとうございます。
月曜日に出社してやってみます。

お礼日時：2018/01/13 12:27