【マクロ】上のデータに下のデータを、結合する

【やりたい事】
以下画像の、赤枠部分を切取し、上のデータの
最終行の下（A6）に貼付したいです

以下のコードは、やりたい事を実現するコードです

●他の方法で、簡単に、分かりやすいコードをご存じの方アドバイス等含め
ご指南をお願いします

【条件】
・上データの最終行の次の行から、下データの開始行の間は
　常に【9セル】空いています

・上のデータと下のデータの数は、増えたり減ったりします


【コード】
Sub データをつなげる()

Dim lastrow As Long

lastrow = Cells(1, 1).End(xlDown).Row


Cells(lastrow + 9, "A").CurrentRegion.Cut

Cells(lastrow + 1, "A").Select

ActiveSheet.Paste

End Sub

No.3 ベストアンサー 回答者： fujillin 回答日時： 2025/03/11 15:43

こんにちは

ご質問文に記載のない条件が不明なので、よくわかりませんけれど・・

タイトルにある「上のデータに下のデータを結合する」ような場合に、よく用いられるのは『空白行を削除して上に詰める』という処理だと思います。
ただし、これはご提示の条件には必ずしも当てはまらない（＝空白の連続行数を考慮しない）ので、採用はできなさそうですね。


一方で、示された条件には、
　＞常に【9セル】空いています
とありますが、ご提示の図では、空白セルは8つで、矛盾しているように見えます。
また、ご提示のコードの場合、最初のデータの連続が1つ（要は、Ａ1セルにのみ値があり、Ａ2セルから空白）の場合は、うまく行かないと思いますし、元データがＡ1セルのみ（または全体が空白列）になっているとエラーになります。
とは言え、そのようなことはないものと想定してよいという条件なのだと解釈しました。


＞他の方法で、簡単に、分かりやすいコードを～～
ご提示の処理内容でよいのなら、ご提示のコードは十分に簡単でわかりやすいと思いますので、それ以上に分かりやすいものはほぼないでしょう。

多少なりとも、短い記述にするのなら、
　With Cells(1, 1).End(xlDown)
　　.Offset(9).CurrentRegion.Cut .Offset(1)
　End With
などでも可能ですが、簡単で分かりやすいかについては不明です。
　　　　　　　　　（↑人にもよると思いますので・・）
また、上記記述はご提示のコードと処理内容は同じですので、元データの状態によってはエラーが発生する点なども変わりはありません。

No.2 回答者： tatsumaru77 回答日時： 2025/03/11 15:40

空いているセルの数に関係なく、空白行を詰めるマクロです。

Public Sub 空白行削除()
Dim lastrow As Long
Dim arr As Variant
Dim i As Long
Dim j As Long: j = 1
lastrow = Cells(Rows.count, 1).End(xlUp).Row
If lastrow < 2 Then Exit Sub
arr = Range(Cells(1, 1), Cells(lastrow, 1)).Value
Range(Cells(1, 1), Cells(lastrow, 1)).ClearContents
For i = 1 To UBound(arr, 1)
If arr(i, 1) <> "" Then
Cells(j, 1).Value = arr(i, 1)
j = j + 1
End If
Next
End Sub

No.1 回答者： MitTKG 回答日時： 2025/03/11 13:21

こんなのはどうです？forループ最強

Sub remove9blanks()

For iy = 1 To Cells(1, 1).End(xlToRight).Column

lastrow1 = Cells(1, iy).End(xlDown).Row

x2 = lastrow1 + 10

lastrow2 = Cells(x2, iy).End(xlDown).Row

For ix = x2 To lastrow2
Cells(ix - 9, iy).Value = Cells(ix, iy).Value
Cells(ix, iy).Value = ""
Next

Next

End Sub