Excel VBA 転記について

F列にナンバー
G列にナンバー
H列に都道府県

この状態で、3個飛ばしで転記をしたいのです。

下記のコードを作成しました。

Sub 転記()
Dim maxR As Long
Dim maxC As Long

maxR = Cells(Rows.Count, "F").End(xlUp).Row
maxC = Cells(7, Columns.Count).End(xlToLeft).Column

j = 8
For i = 8 To maxR


Range(Cells(j, "G"), Cells(j, maxC)).Copy Cells(i + 34, 7)

j = j + 3

Next i

End Sub

↓結果です。

2 青森県
5 秋田県
8 茨城県
11 埼玉県
14 神奈川県
17 石川県
20 長野県
23 愛知県
26 京都府
29 奈良県
32 島根県

8 茨城県
17 石川県
26 京都府

26 京都府



空白
８の茨城1
17の石川県
26の京都府
空白
26の京都府

3個飛ばしで転記はできましたが
下記の

空白
８の茨城1
17の石川県
26の京都府
空白
26の京都府

上記の余計なものが転記されます。
なぜこうなるのか分かりません。

お手数ですが、正しいコードをご教示いただけないでしょうか？
よろしくお願いします。

No.1 ベストアンサー 回答者： kantansi 回答日時： 2023/02/28 10:09

以下のコードで、空白行を除いて転記することができます。

Sub 転記()
Dim maxR As Long
Dim maxC As Long
Dim j As Long
Dim i As Long

scss
Copy code
maxR = Cells(Rows.Count, "F").End(xlUp).Row
maxC = Cells(7, Columns.Count).End(xlToLeft).Column

j = 8
For i = 8 To maxR Step 3
If Not IsEmpty(Cells(j, "F")) Then
Range(Cells(j, "G"), Cells(j, maxC)).Copy Cells(i + 34, 7)
End If
j = j + 3
Next i
End Sub

このコードでは、余計な空白行を取り除くために、Forループのステップに3を指定している行を取り出す前に、その行が空白かどうかをチェックしています。空白の場合はスキップし、空白でなければ転記を行うようにしています。

この回答へのお礼

出来ました。
ありがとうございました。

お礼日時：2023/02/28 13:24

No.2 回答者： fujillin 回答日時： 2023/02/28 11:37

こんにちは

＞上記の余計なものが転記されます。
＞なぜこうなるのか分かりません。
以下は想像ですが・・・
一度転記してから、再度同じ処理を実行していませんか？
その場合は、最終行が53行目くらいまでになっていて、そこまでを3行おきにピックアップすることになります。

転記先を42行目からと固定にしているので、最終行を求めた際に41行目より大きければ、ダブって転記されることになると考えられます。
最終行を41行目以下になるように限定してあげれば良いのではないでしょうか？
あるいは、事前に42行目以降をクリアしておくなどでも宜しそうに思われます。

この回答へのお礼

ありがとうございました。
参考にします

お礼日時：2023/02/28 13:24