【マクロ 画像あり】セル範囲の移動について、簡潔で短いマクロがあれば教えて下さい

【やりたい事】
以下画像にて、A列のかきくけこ３行を、C列のあいうえおの最終行の次に
切取りをして、貼付したいです

貼付方法や手順は、指定はありません。以下コードは自分が思いついただけのものです
【条件】
・xの数は、常に変動
・水色は、デフォルトである、データとします
⇒ただし、常にあいうえおやかきくけこの数へ変更します
・A列、上と下のセルの間は常に８セル

より簡潔なコードがあれば教えて下さい
宜しくお願いします

【コード】
Sub かきくけこ移動()

Dim lastrow1 As Long
lastrow1 = Cells(1, 1).End(xlDown).Row

Dim lastrow2 As Long
lastrow2 = Cells(Rows.Count, "c").End(xlUp).Row

Dim lastrow3 As Long
lastrow3 = Cells(Rows.Count, "a").End(xlUp).Row

For i = (lastrow1 + 9) To lastrow3

If Cells(i, 1) <> "x" Then

Cells(i, 3) = Cells(i, 1)

End If

Next i


Cells(lastrow1 + 9, "c").CurrentRegion.Cut

Cells(lastrow2 + 1, "c").Select

ActiveSheet.Paste


End Sub

No.1 ベストアンサー 回答者： tatsumaru77 回答日時： 2025/03/15 20:42

ちょっと、短くなるだけですが。

Sub かきくけこ移動()

Dim lastrow1 As Long
lastrow1 = Cells(1, 1).End(xlDown).Row

Dim lastrow2 As Long
lastrow2 = Cells(Rows.count, "c").End(xlUp).Row

Dim lastrow3 As Long
lastrow3 = Cells(Rows.count, "a").End(xlUp).Row
Dim i As Long
Dim j As Long
j = lastrow2 + 1
For i = (lastrow1 + 9) To lastrow3

If Cells(i, 1) <> "x" Then

Cells(j, 3) = Cells(i, 1)
j = j + 1
End If

Next i

End Sub

この回答へのお礼

みたこともない、すごい、技とだと思いました
j = j + 1　ですね。ご指南ありがとうございます

お礼日時：2025/03/18 01:06