複数のエクセルブックから特定シートの特定セル抽出

質問

同一フォルダ内にある複数のExcelブックから特定シートの特定セル値を抽出して一覧表にまとめるExcel マクロ（VBA）を教えてください。
よく似ている質問、回答を読んだのですが、私のレベルではとても応用できず質問させていただきます。

【前提】
・実行する端末のOSはWindows XP（SP3）、Excelは2003
・対象フォルダはネットワーク接続フォルダ「\データ解析\データ」
　この中に、複数のExcelブックがあります。
・抽出したい対象は、各ブック内のシート（シート名はファイル名と同じ）の「BO6からBW16までの□の範囲」で統一されています。

【抽出一覧作成イメージ】
・「集計.xls」ブックの「Sheet1」の２行目から抽出した結果を一覧表示する。
・表示はA列に抽出元ブック名（＝ファイル名）、B列に抽出元BO6セルの値。以降，C列・D列と
順に値を入れていきたい。
・BO6～BW16までのセル値を「集計.xls」ブックの「Sheet1」に貼り付ける際には「値で貼り付ける」が望ましい。

というようなイメージです。
とても勝手なお願いではありますが、宜しくお願いいたします。

回答No.2

keithin · ベストアンサー

マクロ自体はごく簡単な内容ですが、

＞対象フォルダはネットワーク接続フォルダ「\データ解析\データ」

情報提供が不足しているので「コピーしてそのまま使えるマクロ」を書いてもらう事はできません。

sub macro1()
　dim myPath as string
　dim myFile as string
　dim h as range
　dim r as long
　dim c as long

’次の正確なパスをご自分で調べて正しく記入する事
　mypath = "\\コンピュータ名\データ解析\データ\"

　myfile = dir(mypath & "*.xls*")
　do until myfile = ""
　　workbooks.open mypath & myfile
　　r = workbooks("集計.xls").worksheets("Sheet1").range("A65536").end(xlup).offset(1).row
　　workbooks("集計.xls").worksheets("Sheet1").cells(r, "A") = myfile
　　c = 1
　　for each h in worksheets(split(myfile, ".")(0)).range("BO6:BM16")
　　　c = c + 1
　　　workbooks("集計.xls").worksheets("Sheet1").cells(r, c).value = h.value
　　next
　　workbooks(myfile).close false
　　myfile = dir()
　loop

end sub

正確なパスの調べ方が分からないなら、たとえば
１．新しいマクロの記録を開始する
２．目的のネットワークフォルダに保存されているどれかてきとーなブックを１つ開く
３．記録終了する
４．記録されたマクロを開き、そこに書かれてるパスの記述を確認する
といった具合にご自分の手を動かして調査します。

お礼

非常に困っていたので，助かりました。
無事に実行することができました。
ありがとうございます。

回答No.1

masatsan

大変言いにくいのですが、少しは努力した結果を示していただかないと、回答ではなく仕事を依頼されたみたいになっちゃいます。