VBA：別ブックの最終行までのデータをコピーし、当ブックの最終行に転記する方法。

Question

閲覧ありがとうございます。

表題の件で質問いたします。

具体的な操作手順

1. data1.xlsxの「A1:A最終行」を取得し、その範囲をコピーする。
2. 当ブック(VBAが書かれたブック)でA列の最終行に1.を転記する。

こちら操作を行いたいです。

また、もし可能であれば「複数の別ブックのデータを1つのExcelにまとめる操作」以下の操作も行いたいです。

具体的な操作手順

1. list.xlsxの1行目に書かれたファイルパスを取得
2. 取得したファイルパスの「A1:A最終行」を取得し、その範囲をコピーする。
3. 当ブック(VBAが書かれたブック)のA列の最終行に2.を転記する。
4. 1.で読み込む行を+1し、1~3をlist.xlsxの最終行まで実行

現在できているコードは以下です。
別ブックの最終行を取得することができず、躓いています。

Sub CopyCell()
'最終行を取得
endrow = Cells(Rows.Count, "A").End(xlUp).Row + 1

With Workbooks.Open("C:\Users\aaa\Desktop\test.xlsx")
    '「貼付元」シートを全部コピー（★ここの最終行の取得方法がわからないです。）
    Range("A1").Value = r
    .Worksheets("Sheet1").Range("A" & 1 & ":A" & endrow).Copy
    'このブックの「貼付先」シートへ値貼り付け
    ThisWorkbook.Worksheets("Sheet1").Cells(endrow, 1).PasteSpecial _
        xlPasteValuesAndNumberFormats
    'コピー中状態を解除
    Application.CutCopyMode = False
    'ブックを保存せずに閉じる
    .Close False
End With
End Sub

Comments

[hatena19]

list.xlsx というのはこのコードが記載されているブックですか。

[aza]

はいそうです！
A列に以下のパスが書かれているイメージです。

1行目　C:\Users\aaa\Desktop\test.xlsx
2行目　C:\Users\aaa\Desktop\test1.xlsx
3行目　C:\Users\aaa\Desktop\test2.xlsx
4行目　C:\Users\aaa\Desktop\test3.xlsx

Answer 1

とりあえずは、一つのブックを開いて、貼り付けるプロシージャを書いてみましょう。
ブックのパスは引数で渡しようにしておくといいでしょう。

それができたら、複数のブックのパスを引数で渡してループするコードを書けば完成です。

あと、コピー元とコピー先（ThisWorkBook）が明確にわかるように変数を用意して、
そこに格納しておくと可読性が上がります。
Withもうまく使うとシンプルに記述できますが、複数のブックがあり、コードが長くなると
可読性が犠牲になる場合もあります（その辺はケースバイケースです。）

Sub CopyData(wbPath As String)
    Dim SourceWB As Workbook
    Set SourceWB = Workbooks.Open(wbPath)
    Dim SourceLastrow As Long
    SourceLastrow = SourceWB.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row

    SourceWB.Worksheets("Sheet1").Range("A1").Resize(SourceLastrow).Copy

    Dim TargetWB As Workbook
    Set TargetWB = ThisWorkbook
    Dim TargetLastrow As Long
    TargetLastrow = TargetWB.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row

    TargetWB.Worksheets("Sheet1").Cells(TargetLastrow, 1).PasteSpecial _
        xlPasteValuesAndNumberFormats

    Application.CutCopyMode = False
    SourceWB.Close False
End Sub

'上記プロシージャの動作確認
Sub RunTestCopyData()

    Call CopyData("C:\Users\aaa\Desktop\test.xlsx")

End Sub

RunTestCopyDataがエラーなく実行されることが確認出来たら、ループ処理のコーディングへ移行します。

---

CopyDataプロシージャが問題なく実行できたら、ループ処理は下記のようになります。
list.xlsxのパスは実際のものに変更してください。

Sub CopyBooksData()
    Application.ScreenUpdating = False
    
    Dim listWB As Workbook
    Set listWB = Workbooks.Open("C:\test\list.xlsx")
    Dim listLastrow As Long
    listLastrow = listWB.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
    Dim listRng As Range
    Set listRng = listWB.Worksheets("Sheet1").Range("A1").Resize(listLastrow)
    
    Dim wbPathRng As Range
    For Each wbPathRng In listRng
        Call CopyData(wbPathRng.Value)
    Next

    listWB.Close False
    Application.ScreenUpdating = True
End Sub

Comments

[aza]

ご回答ありがとうございます。
Withは場合によっては使用しない方がいいのですね！
ご丁寧にありがとうございます。

すいません、ご教授いただいた方法で実行するとエラーになってしまいました。。。
「実行時エラー:;438 オブジェクトはこのプロパティまたはメソッドをサポートしていません」と表示されます。

Sub RunTestCopyData()
Call CopyData("C:\Users\aaa\Desktop\test.xlsx")
End Sub
変更点としては、上記のコードのファイルパスを変更しただけです。
他で変更する点はございますでしょうか。
申し訳ございませんが、ご教授いただけますと幸いです

[hatena19]

あ～、すみません。コードが一部不足してました。
修正しましたので、もう一度試してみてください。

[aza]

hatena19さん、ご回答ありがとうございました！
1週間くらい考えてもわからなかったのですが、hatena19さんのおかげでできました！
仕事でエクセルファイルの集計で必要だったので、助かりました。。。
ありがとうございますm(__)m

Answer 2

とりあえず、test.xlsxの最終行を求めて、貼り付ける方法は以下のようになります。

Sub CopyCell()
'最終行を取得
endrow = Cells(Rows.Count, "A").End(xlUp).Row + 1


With Workbooks.Open("C:\Users\aaa\Desktop\test.xlsx")
    Dim lastrow As Long
    lastrow = Cells(Rows.Count, "A").End(xlUp).Row
    '「貼付元」シートを全部コピー（★ここの最終行の取得方法がわからないです。）
    'Range("A1").Value = r  '・・・・・コピー元をクリアしてはいけないのでコメントアウトしておく
    .Worksheets("Sheet1").Range("A" & 1 & ":A" & lastrow).Copy
    'このブックの「貼付先」シートへ値貼り付け
    ThisWorkbook.Worksheets("Sheet1").Cells(endrow, 1).PasteSpecial _
        xlPasteValuesAndNumberFormats
    'コピー中状態を解除
    Application.CutCopyMode = False
    'ブックを保存せずに閉じる
    .Close False

End With
End Sub

list.xlsxを使用して複数のファイルを処理する場合ですが、
マクロ実行時、list.xlsxはオープン済みという前提でよいのですか。
それとも、list.xlsxもマクロで、オープンしてから始めるのですか。

Comments

[aza]

早速のご回答ありがとうございます！

ご教授いただいた方法では、別シートの最終行を取得することができませんでした。
すみません。
しかし、教えていただいたコードのうち、
.Worksheets("Sheet1").Range("A" & 1 & ":A" & lastrow).Copy
を
.Worksheets("Sheet1").Range("A" & 1 & ":A" & 50000).Copy
のようにすると、最終行は取得できませんが、50000行までであればコピーできるようになりました。
ありがとうございます。
大変お手数でございますが、最終行を取得する方法がほかにございましたら、ご教授いただけると幸いです。申し訳ありません。。。

>list.xlsxを使用して複数のファイルを処理する場合ですが、
>マクロ実行時、list.xlsxはオープン済みという前提でよいのですか。
>それとも、list.xlsxもマクロで、オープンしてから始めるのですか。
→オープンから始められれば一番ですが、オープン済みでも大丈夫です！
よろしくおねがいします！

[hatena19]

「質問への追記・修正の依頼」へのコメントでは、このコードが記述されているブック(=ThisWorkBook)とのことですが、コードが記述されているブックとは別のブックなのですか。
どちらなのか明確にしてください。
おっと、よく見たら拡張子が xlsx なのでコードが記載できないですね。
ということは、

コピー先ブック（VBAコードが記載されているブック）
list.xlsx （コピー元ブックのバスが記載されているブック）
コピー元ブック(複数)
の３つあるということですね。

[aza]

説明不足ですみません。
ご指摘のとおり、使用ファイルは3つございます。
①コピー先ブック（VBAコードが記載されているブック）
②list.xlsx （コピー元ブックのバスが記載されているブック）
③コピー元ブック(複数)

すみません、ありがとうございます。

[aza]

tatsu99さん、ご回答ありがとうございました！
皆様のおかげで解決しました！
ありがとうございましたm(__)m