複数のブックのデータを一つのブックにまとめたい

質問

http://t_shun.at.infoseek.co.jp/My_Page/Excel-VBA/vba_page1.htm

↑の　7. 指定したフォルダ内にあるExcelファイルを検索して開く　の部分のマクロを利用して、集計.xlsというブックで、複数のブックを開くようにしましたが、そのブックを開いた時にそのブックのSheet2の中のデータのみコピーして、集計.xlsに貼り付けたいのですが、どのようにすればよいのか困っています。

指定したフォルダの中には、回答01.xls　回答02.xls　・・・と16個のブックがあります。順番に開いてコピーをするときに、どのようにブック名とシート名を指定すればよいのかわからず困っています。

何か参考になるものがあれば教えてください。
よろしくお願いします。

回答No.1

papayuka · ベストアンサー

元のサンプルを修正して、開いたブックの"Sheet2" A1 の値を、マクロのあるブックの一番左のシートのA列に順番に転記しています。
この場で書いたのでテストしておらず、上手く動くか解りません。
試すならテスト環境でどうぞ。

Sub BookOpen_7()
Dim i As Long, wb as Workbook　'←修正
　　　　・
　　　　・
' ↓下記２行は不要なら ' でコメントアウト
' Rec = MsgBox(FName & "を開きますか", vbYesNo)
' If Rec = vbYes Then
　　 ' ↓修正
　　 Set Wb = Workbooks.Open FName
　　 ' ↓追加
　　 ThisWorkbook.Worksheets(1).Rnage("A65536").End(xlup).Offset(1,0).value = _
　　　　　　　Wb.Worksheets("Sheet2").Rnage("A1").value
　　 Wb.Close
' ↓不要なら ' でコメントアウト
' End if
　　　・
　　　・

お礼

早速のご回答ありがとうございます。
自分でやってみて、ThisWorkbook.Worksheets・・・からがよくわからず、以前に教えて貰ったもので入れ替えてみたら、出来ました♪また何かありましたらよろしくお願いします。

Sub BookOpen_7()
Dim i As Long, wb As Workbook
Dim FName As String
Dim k_i As Long
Application.ScreenUpdating = False
With Application.FileSearch
.NewSearch
.LookIn = ThisWorkbook.Path
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
If .Execute > 0 Then
For i = 1 To .FoundFiles.Count
FName = .FoundFiles(i)
Set wb = Workbooks.Open(FName)
If i = 1 Then
wb.Worksheets("Sheet1").Range("B3:AQ4").Copy _
Destination:=ThisWorkbook.Worksheets("Sheet1").Range("B3")
End If
For k_i = 5 To wb.Worksheets("Sheet1").Range("B65536").End(xlUp).Row
addR_No = ThisWorkbook.Worksheets("Sheet1").Range("B65536").End(xlUp).Row + 1
wb.Worksheets("Sheet1").Range("B" & k_i & ":AQ" & k_i).Copy _
Destination:=ThisWorkbook.Worksheets("Sheet1").Range("B" & addR_No & ":AQ" & addR_No)
Next
wb.Close
Next i
Else
MsgBox "対象ファイルはありませんでした"
End If
End With
Application.ScreenUpdating = True
End Sub

補足

Set Wb = Workbooks.Open FName
この記述の仕方がわからず悩んでいたので、大変感謝しています。