エクセルファイルの特定セルに別エクセルファイルのデータを入力することについて

　お詳しい方よろしくお願いします。
<状況>
（１）ファイル名が「001.xlsx」から「100.xlsx」まで100個のエクセルファイルがあります。
（２）これら100個のファイルそれぞれのA1セルに入力したいデータが入力されたエクセルファイル(集約データ.xlsx)があります。
集約ファイル.xlsxの内容
　　　A列　　　　　　　　　　B列
1　　001　　平成２１年４月から平成２１年５月まで
2　　002　　平成２１年７月から平成２１年１２月まで
3　　003　　平成２１年４月から平成２１年１０月まで
・
・
というように、A列にはデータ出力先エクセルファイル名
Ｂ列には、Ａ列に入力されたエクセルファイルのA1セルに出力したいデータが格納されています。

<行いたい作業>
集約データ.xlsxのＢ列に格納してあるデータをＡ列のファイルに出力したいと考えています。
ついては、この方法をご教示いただきたいと存じます。
よろしくお願いします。

No.1 ベストアンサー 回答者： merlionXX 回答日時： 2009/12/20 17:42

.xlsxということは2007以降ですね。

わたしのは2003なので2007で動くかどうか自信ありません。
また質問を勘違いしたかも知れませんが以下の前提で回答します。

1.VBAコードは集約データ.xlsx　の標準モジュールに記載する。
2.集約ファイル.xlsxの内容は一枚目のシートのA1:B100の範囲にある。
3.集約ファイル.xlsxおよび「001.xlsx」から「100.xlsx」まで100個のエクセルファイルは同一フォルダー内にある。
4.転記先のA1セルは開いたときに表示されるシートにある。

Sub TEST01()
Dim mb As Workbook, wb As Workbook
Dim myFd As String
Application.ScreenUpdating = False '画面更新を一時停止
Set mb = ThisWorkbook 'このBookをmbとする。
myFd = mb.Path 'フォルダー名取得
For i = 1 To 3 '1から100まで
Set wb = Workbooks.Open(myFd & "\" & mb.Sheets(1).Cells(i, "A").Value & ".xlsx") 'その名のBOOKを開きwbとする。
wb.ActiveSheet.Range("A1").Value = mb.Sheets(1).Cells(i, "B").Value '開いたシートのA1に転記
wb.Close (True) '保存の有無を聞かずに保存して閉じる
Next '繰り返し
Application.ScreenUpdating = True '画面更新一時停止を解除
End Sub

この回答へのお礼

　どうもありがとうございました。
　ご教示いただいたコードで無事処理できました。
　作業時間が大幅に短縮できました。
　これまでは、縁遠く、なじめなかったマクロですが、ご教示いただいたのきっかけに一念発起し、現在テキストで勉強しているところです。
　本当にありがとうございました。

お礼日時：2009/12/31 15:34

No.2 回答者： merlionXX 回答日時： 2009/12/21 09:28

おはようございます。

昨夜回答したmerlionXXです。
さきほどExcel2007で試してみました。
No1で回答のコードで作動を確認しました。

ただ、もうおわかりとは思いますが、コードで

For i = 1 To 3 '1から100まで　　

の部分については、わたしは実際には１００個のファイルではなく001~003の３つのファイルで試したのでFor i = 1 To 3 としてますが、ほんとに100個までなら　1 To 100 としなくてはいけません。

また、このコードを書いた「集約データ.xlsx」 は、コードを保持したまま保存することができませんでした。
マクロをふくんだまま保存するには「集約データ.xlsm」 と拡張子を変更しなければなりませんでした。
この点、2007をあまり使ったことがなかったので勉強になりました。

以上蛇足でした。

この回答へのお礼

　お忙しい中何度もご回答いただきありがとうございます。
　土、日は作業ができなかったので、これから実施してみます。
　（今日中に終わるかな？という感じですが）
　実は、マクロ（ＶＢＡコードの作成（？））はまったくの初心者でして…
　引き続きご教示いただくかもしれませんが、よろしくお願いします。

お礼日時：2009/12/21 11:16