• ベストアンサー

複数のブックからデータを転記するマクロについて

こんにちは。 VBAの素人なのでネットや本などで自分なりに調べましたが、 どうにも解決できないので、ご教示いただけませんでしょうか。 複数のブックにある同一セル番地にある データを別のブックにまとめたいのですが、 ブック数が500程度あり、マクロでうまくできないか悩んでいます。  (1)転記元ブックを開く。  (2)転記元データをコピーする。  (3)転記先ファイルのセルに貼り付ける。  (4)転記元ブックを閉じる。 の繰り返しだと思うのですが、(2)ができず困っています。 ちなみに、500のブックとまとめるブックも同じフォルダにあります。 具体的には、転記元ブックは以下のような形で、A列に様々な温度のデータが縦に並んでいます。    A列   1行  温度  2行  27 ←ここのみ抽出したい 3行  28 4行  30 それぞれのブックのA2番地の温度データのみを抽出し、転記先ブックのA2からA500までまとめたい。 組んだマクロは以下です。 ------------------------------ Sub 特定フォルダ内ブックを並べ替えて転記() Dim myDir As String, myName As String, myBook As Workbook Dim motodata As Range, sakidata As Range   '集計用のブックがあるフォルダ名を指定 myDir = "D:\VBA練習" myName = Dir(myDir & "\" & "*.xls")   Do While myName <> ""   '↓転記先の最新レコード位置を取得する   Set sakidata = Range("A65536").End(xlUp).Offset(1)   '↓(1)指定した名前のブックを開いて変数に格納する  Set myBook = Workbooks.Open(Filename:=myDir & "\" & myName)   '↓(2)転記元を取得する   Set motodata = myBook.Range("A2")      '↓(3)転記先に貼り付ける   motodata.Copy sakidata   '↓(4)開いたブックを閉じる   myBook.Close  myName = Dir()  Loop End Sub ------------------------------ mybookというキーワードを使用して、A2セルデータをコピーする構文をご教示いただけませんでしょうか。 以上、長々となってしまいましたが、何卒アドバイスの程お願いいたします。

質問者が選んだベストアンサー

  • ベストアンサー
  • hige_082
  • ベストアンサー率50% (379/747)
回答No.2

複数のBookやSheetの処理をする場合 #1さんも言われてるように、Book、Sheetを省略すると 現在アクティブになっている、Book、Sheetを指定したことになってしまいます 一応、修正してみましたが Sheet名が不明なため"ActiveSheet"としていますが 複数Sheetがある場合、希望どおりの結果を得られない可能性があるので "workheet("処理対象シート名")"に変更した方がよいと思います Sub 特定フォルダ内ブックを並べ替えて転記() Dim myDir As String, myName As String, myBook As Workbook Dim motodata As Range, sakidata As Range Dim 転記先 As Worksheet, 転記元 As Worksheet Set 転記先 = ThisWorkbook.ActiveSheet '集計用のブックがあるフォルダ名を指定 myDir = "D:\VBA練習" myName = Dir(myDir & "\" & "*.xls") Do While myName <> "" '↓転記先の最新レコード位置を取得する Set sakidata = 転記先.Range("A65536").End(xlUp).Offset(1) '↓(1)指定した名前のブックを開いて変数に格納する Set myBook = Workbooks.Open(Filename:=myDir & "\" & myName) '↓(2)転記元を取得する Set 転記元 = myBook.ActiveSheet Set motodata = 転記元.Range("A2") '↓(3)転記先に貼り付ける motodata.Copy sakidata '↓(4)開いたブックを閉じる myBook.Close myName = Dir() Loop End Sub 参考まで

1977joe
質問者

お礼

hige_082さん 出来ました!! Dim 転記先 As Worksheet, 転記元 As Worksheet および Set 転記元 = myBook.ActiveSheet Set motodata = 転記元.Range("A2") とすることで、シートも明確になり無事解決しました。 n-junさんも含め、ご両人のご丁寧なアドバイスによって 問題が解決し、本当にありがとうございました!! これでかなり悩んでしたので、仕事が効率化し本当に助かりました。 重ねてお礼申し上げます。

その他の回答 (1)

  • n-jun
  • ベストアンサー率33% (959/2873)
回答No.1

>  '↓(2)転記元を取得する >  Set motodata = myBook.Range("A2") シートを指定しなければダメなのでは。 >  '↓転記先の最新レコード位置を取得する >  Set sakidata = Range("A65536").End(xlUp).Offset(1) ここも”どのブックのどのシート”なのか明確にした方がよいかも。

1977joe
質問者

補足

お返事が遅くなりすみませんでした。 >ここも”どのブックのどのシート”なのか明確にした方がよいかも。 なるほど。 しかし、各ブックのシート名が各ファイル名になっているのですが、 その場合、どのように明確化すればよろしいのでしょうか。 考えてみましたが、素人も私では思いつきませんでした。 重ねてのご質問で恐縮ですが、アドバイスをいただけませんでしょうか。

関連するQ&A