プロが教えるわが家の防犯対策術!

こんにちは。
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セルデータをコピーする構文をご教示いただけませんでしょうか。

以上、長々となってしまいましたが、何卒アドバイスの程お願いいたします。

A 回答 (2件)

>  '↓(2)転記元を取得する


>  Set motodata = myBook.Range("A2")
シートを指定しなければダメなのでは。

>  '↓転記先の最新レコード位置を取得する
>  Set sakidata = Range("A65536").End(xlUp).Offset(1)
ここも”どのブックのどのシート”なのか明確にした方がよいかも。

この回答への補足

お返事が遅くなりすみませんでした。

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

補足日時:2009/03/28 00:09
    • good
    • 0

複数の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

参考まで
    • good
    • 1
この回答へのお礼

hige_082さん

出来ました!!
Dim 転記先 As Worksheet, 転記元 As Worksheet
および
Set 転記元 = myBook.ActiveSheet
Set motodata = 転記元.Range("A2")
とすることで、シートも明確になり無事解決しました。

n-junさんも含め、ご両人のご丁寧なアドバイスによって
問題が解決し、本当にありがとうございました!!

これでかなり悩んでしたので、仕事が効率化し本当に助かりました。

重ねてお礼申し上げます。

お礼日時:2009/03/28 00:41

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています