シートを複数持つExcelファイルを複数ファイル結合する方法

質問

シートを複数持つExcelファイルを複数ファイル結合する方法
○○○工事・▲▲▲工事・■×○工事・・・・と複数のEXCELファイルが有り
そのファイルの中には共通してＡ・Ｂ・Ｃ・Ｄ・・・・シートがあります。

各EXCELファイルの同じ名前のシートを取り出して１つのファイルにしたいと思っています。
１つのファイルにした時、各シート名が抜き出したファイル名になるようにしたいです。

５０ファイル以上ありシート数が２０ある為、なんとかいい方法をお教え下さい。

回答No.1

merlionXX · ベストアンサー

以下の条件で作ってみました。

１．各ファイルは同一のフォルダー内にある。
２．各ファイルはすべて閉じてある。
３．以下のマクロは各データとは別のファイルの標準モジュールに書き、同一フォルダー内に保存する。
４．そのフォルダー内には統合したいファイルと上記３で作成したファイル以外は存在しない。
５．統合されたファイルは同一ファイル内に保存される。

エクセル2000で作成したものです。
2007なら拡張子を変えないとエラーになると思います。

手順は以下のとおりです。

1.新しいBOOKを開き、AltキーとF11キー同時に押し（以下Alt+F11キーと記述）て Visual Basic Editor を呼び出します。
2.Visual Basic Editor のメニューから「挿入」、「標準モジュール」で出てきたコードウィンド（右側の白い広い部分）に以下のコード（Sub～End Sub）をコピペします。

'********これより下**********

Sub Consolidation()
　　Dim mb As Workbook, wb As Workbook, nwb As Workbook
　　Dim ws As Worksheet
　　Dim myFd As String, fnm As String

　　Application.ScreenUpdating = False '画面更新を一時停止
　　Set mb = ThisWorkbook 'このコピー先ブックをmbとする。
　　myFd = ThisWorkbook.Path
　　fnm = Dir(myFd & "\*.xls") 'フォルダ内のExcelブックを検索
　　Do Until fnm = Empty '全て検索
　　　　If fnm <> mb.Name Then 'ブック名がこのブックの名前でなければ
　　　　　　On Error Resume Next
　　　　　　Set wb = Workbooks(fnm)
　　　　　　On Error GoTo 0
　　　　　　If wb Is Nothing Then '開いてなければ
　　　　　　　　Set wb = Workbooks.Open(myFd & "\" & fnm) 'そのブックを開きwbとする。
　　　　　　　　For Each ws In wb.Worksheets '各シート
　　　　　　　　　　On Error Resume Next
　　　　　　　　　　Set nwb = Workbooks(ws.Name & ".xls")
　　　　　　　　　　On Error GoTo 0
　　　　　　　　　　If nwb Is Nothing Then 'シートと同名のBOOKが開いていなければ
　　　　　　　　　　　　ws.Copy 'シートコピーして
　　　　　　　　　　　　ActiveWorkbook.SaveAs myFd & "\" & ws.Name & ".xls" 'BOOK作成
　　　　　　　　　　Else '開いていれば
　　　　　　　　　　　　ws.Copy After:=nwb.Sheets(nwb.Sheets.Count) 'シートコピー
　　　　　　　　　　End If
　　　　　　　　　　Set nwb = Nothing
　　　　　　　　Next
　　　　　　　　wb.Close (False) '保存の有無を聞かずに保存しないで閉じる
　　　　　　End If
　　　　　　Set wb = Nothing
　　　　End If
　　　　fnm = Dir 'フォルダ内の次のExcelブックを検索
　　Loop '繰り返す
　　Application.ScreenUpdating = True '画面更新一時停止を解除
End Sub

'********これより上**********

3.Alt+F11キーでワークシートへもどります。
4.名前を付けて対象となるファイルのある一フォルダー内に保存する。（パス取得のためマクロ実行前に必ず一度は「保存」してあることが必要です。）
5.Alt+F8キーで出てきたマクロ名（Consolidation）を選択して実行します。

お礼

ご回答有難う御座いました。
合体する事が出来ました。