VBA最終行迄をコピーし別ファイルへ追加したいです

質問

大変お世話になっております。
1）Sheet1の2行目から最終行までを取得・コピーをし、同名のシート(Sheet1)の最終行へ追加したいです。
2）BOOK1のSheet1で作業をしており、BOOK2のSheet1へ貼り付けを行います。
3）BOOK1・BOOK2 共に、最終行の判定はC列に文字が入っているものとします。

以下ですと、列が限定されてしまうため、どのようなコードを作成すればよいのか教えていただけると有難い限りです…。
※将来的には、BOOK1の名前が異なる13シート分をBOOK2（BOOK1と同じ名前のシートが13シートあります）へ同様の作業を行いたいです…。

Sub タイトル行を除き別ファイルに追加()
'
Sheets("Sheet1").Activate
Rows("2:7").Select
Selection.Copy
Windows("BOOK2.xlsm").Activate
Rows("25:25").Select
Selection.Insert Shift:=xlDown
Windows("BOOK1.xlsm").Activate
Sheets("Sheet1").Activate
Application.CutCopyMode = False
End Sub

ご回答を心よりお待ちしております…。
お手数ですが、どうぞ宜しくお願い申し上げます。

回答No.4

kkkkkm · ベストアンサー

No.3の追加です。

なんか気になったので追加しておきます。
質問のコードは挿入になっていますが、もし挿入しないのであれば

Ws2.Rows(LastRow2 + 1).Insert Shift:=xlDown
のところを
Ws2.Rows(LastRow2 + 1).PasteSpecial Paste:=xlPasteValues
にすると値だけ貼り付けられます。
Ws2.Rows(LastRow2 + 1).PasteSpecial
にすれば書式もコピペされます。

また、No.1の以下のコピペの所も

Ws1.Range(Ws1.Cells(2, "B"), Ws1.Cells(LastRow1, "G")).Copy Ws2.Cells(LastRow2 + 1, "B")

値だけなら2行にわけて

Ws1.Range(Ws1.Cells(2, "B"), Ws1.Cells(LastRow1, "G")).Copy
Ws2.Cells(LastRow2 + 1, "B").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

挿入するのでしたら

Ws1.Range(Ws1.Cells(2, "B"), Ws1.Cells(LastRow1, "G")).Copy
Ws2.Cells(LastRow2 + 1, "B").Insert Shift:=xlDown
Application.CutCopyMode = False

お礼

kkkkkm 様! お忙しい中、ご回答をしていただきまして本当に有難うございました! ご提示をくださいましたコードを、今使わせていただきました…! お陰様で、すぐに解決が出来ました…! ご回答をいただきまして、心より感謝申し上げます…!!

Powered by GRATICA

回答No.3

kkkkkm

No.1No.2の追加です。
あと質問のコードのように行ごとコピペして挿入したいのでしたら以下でいけると思います。

Sub Test2()
Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim LastRow1 As Long, LastRow2 As Long

Set Ws1 = Workbooks("Book1.xlsm").Sheets("Sheet1")
Set Ws2 = Workbooks("Book2.xlsm").Sheets("Sheet1")

LastRow1 = Ws1.Cells(Ws1.Rows.Count, "C").End(xlUp).Row
LastRow2 = Ws2.Cells(Ws2.Rows.Count, "C").End(xlUp).Row

Ws1.Rows("2:" & LastRow1).Copy
Ws2.Rows(LastRow2 + 1).Insert Shift:=xlDown

Application.CutCopyMode = False

Set Ws1 = Nothing
Set Ws2 = Nothing

End Sub

回答No.2

kkkkkm

No.1の訂正です。

B列からG列

じゃなかったですね。行の所を列だと思ってました。
コードの

s1.Range(Ws1.Cells(2, "B"), Ws1.Cells(LastRow1, "G")).Copy Ws2.Cells(LastRow2 + 1, "B")

"B"や"G"を実際にコピーしたい列に合わせてください。

回答No.1

kkkkkm

Boook1のSheet1のC列最終行のB列からG列までを
Boook2のSheet1のB列からG列までC列最終行の次から追加
だと思いましたので

Sub Test()
Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim LastRow1 As Long, LastRow2 As Long

Set Ws1 = Workbooks("Book1.xlsm").Sheets("Sheet1")
Set Ws2 = Workbooks("Book2.xlsm").Sheets("Sheet1")

LastRow1 = Ws1.Cells(Ws1.Rows.Count, "C").End(xlUp).Row
LastRow2 = Ws2.Cells(Ws2.Rows.Count, "C").End(xlUp).Row

Ws1.Range(Ws1.Cells(2, "B"), Ws1.Cells(LastRow1, "G")).Copy Ws2.Cells(LastRow2 + 1, "B")

Set Ws1 = Nothing
Set Ws2 = Nothing

End Sub