エクセル ＶＢＡでの転記の方法について

転記が上手くいきません。ご教授いただきたくお願いいたします。
A列から、名前、記号、県名、金額　の表があるとして、
名前”田中”の場合のみ、その列を右側セルに転記していくコードですが、
添付画像の様に、同じ値（ループ最後の25行目の田中列）だけが貼りついてしまい上手くいきません。
貼りつけたいのは、”田中、A、東京、100”、次の行に、”田中、C、神奈川、400”・・・と
次行へ続けたいのですが、下記コードで何がいけないのかの理由と、
できるだけ簡素に記述できるコード見本があればお願いいたします。

Sub 範囲3転記不具合()

Dim rg As Range
Dim ctR As Long
Dim i As Long

ctR = 2

For i = 2 To 25
If Cells(i, 1) = "田中" Then
Set rg = Range(Cells(i, 1), Cells(i, 4))
rg.Copy Cells(ctR, 8).CurrentRegion

ctR = ctR + 1

End If
Next i
End Sub

No.1 ベストアンサー 回答者： tatsumaru77 回答日時： 2023/10/22 20:23

rg.Copy Cells(ctR, 8).CurrentRegion

を
rg.Copy Cells(ctR, 8)
にしてください。

この回答へのお礼

できました！ありがとうございました！
m(_ _)m

お礼日時：2023/10/25 00:57