質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.44%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

コピー

元のオブジェクトを破壊することなく、オブジェクトの複製を生成することをコピーと呼びます。

Q&A

解決済

2回答

30995閲覧

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

aza

総合スコア14

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

コピー

元のオブジェクトを破壊することなく、オブジェクトの複製を生成することをコピーと呼びます。

0グッド

0クリップ

投稿2019/09/17 01:51

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

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

具体的な操作手順

  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の最終行まで実行

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

VBA

1Sub CopyCell() 2'最終行を取得 3endrow = Cells(Rows.Count, "A").End(xlUp).Row + 1 4 5With Workbooks.Open("C:\Users\aaa\Desktop\test.xlsx") 6 '「貼付元」シートを全部コピー(★ここの最終行の取得方法がわからないです。) 7 Range("A1").Value = r 8 .Worksheets("Sheet1").Range("A" & 1 & ":A" & endrow).Copy 9 'このブックの「貼付先」シートへ値貼り付け 10 ThisWorkbook.Worksheets("Sheet1").Cells(endrow, 1).PasteSpecial _ 11 xlPasteValuesAndNumberFormats 12 'コピー中状態を解除 13 Application.CutCopyMode = False 14 'ブックを保存せずに閉じる 15 .Close False 16End With 17End Sub

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

hatena19

2019/09/17 02:05

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

2019/09/17 05:15

はいそうです! 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
guest

回答2

0

ベストアンサー

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

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

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

vba

1Sub CopyData(wbPath As String) 2 Dim SourceWB As Workbook 3 Set SourceWB = Workbooks.Open(wbPath) 4 Dim SourceLastrow As Long 5 SourceLastrow = SourceWB.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row 6 7 SourceWB.Worksheets("Sheet1").Range("A1").Resize(SourceLastrow).Copy 8 9 Dim TargetWB As Workbook 10 Set TargetWB = ThisWorkbook 11 Dim TargetLastrow As Long 12 TargetLastrow = TargetWB.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row 13 14 TargetWB.Worksheets("Sheet1").Cells(TargetLastrow, 1).PasteSpecial _ 15 xlPasteValuesAndNumberFormats 16 17 Application.CutCopyMode = False 18 SourceWB.Close False 19End Sub 20 21'上記プロシージャの動作確認 22Sub RunTestCopyData() 23 24 Call CopyData("C:\Users\aaa\Desktop\test.xlsx") 25 26End Sub

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


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

vba

1Sub CopyBooksData() 2 Application.ScreenUpdating = False 3 4 Dim listWB As Workbook 5 Set listWB = Workbooks.Open("C:\test\list.xlsx") 6 Dim listLastrow As Long 7 listLastrow = listWB.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row 8 Dim listRng As Range 9 Set listRng = listWB.Worksheets("Sheet1").Range("A1").Resize(listLastrow) 10 11 Dim wbPathRng As Range 12 For Each wbPathRng In listRng 13 Call CopyData(wbPathRng.Value) 14 Next 15 16 listWB.Close False 17 Application.ScreenUpdating = True 18End Sub

投稿2019/09/17 06:19

編集2019/09/17 07:28
hatena19

総合スコア33856

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

aza

2019/09/17 06:44

ご回答ありがとうございます。 Withは場合によっては使用しない方がいいのですね! ご丁寧にありがとうございます。 すいません、ご教授いただいた方法で実行するとエラーになってしまいました。。。 「実行時エラー:;438 オブジェクトはこのプロパティまたはメソッドをサポートしていません」と表示されます。 Sub RunTestCopyData() Call CopyData("C:\Users\aaa\Desktop\test.xlsx") End Sub 変更点としては、上記のコードのファイルパスを変更しただけです。 他で変更する点はございますでしょうか。 申し訳ございませんが、ご教授いただけますと幸いです
hatena19

2019/09/17 07:04

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

2019/09/17 08:39

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

0

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

vba

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

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

投稿2019/09/17 02:52

tatsu99

総合スコア5487

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

aza

2019/09/17 05:32 編集

早速のご回答ありがとうございます! ご教授いただいた方法では、別シートの最終行を取得することができませんでした。 すみません。 しかし、教えていただいたコードのうち、 .Worksheets("Sheet1").Range("A" & 1 & ":A" & lastrow).Copy を .Worksheets("Sheet1").Range("A" & 1 & ":A" & 50000).Copy のようにすると、最終行は取得できませんが、50000行までであればコピーできるようになりました。 ありがとうございます。 大変お手数でございますが、最終行を取得する方法がほかにございましたら、ご教授いただけると幸いです。申し訳ありません。。。 >list.xlsxを使用して複数のファイルを処理する場合ですが、 >マクロ実行時、list.xlsxはオープン済みという前提でよいのですか。 >それとも、list.xlsxもマクロで、オープンしてから始めるのですか。 →オープンから始められれば一番ですが、オープン済みでも大丈夫です! よろしくおねがいします!
hatena19

2019/09/17 06:26

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

2019/09/17 06:46

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

2019/09/17 08:41

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

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.44%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問