- ベストアンサー
シートを複数持つExcelファイルを複数ファイル結合する方法
シートを複数持つExcelファイルを複数ファイル結合する方法 ○○○工事・▲▲▲工事・■×○工事・・・・と複数のEXCELファイルが有り そのファイルの中には共通してA・B・C・D・・・・シートがあります。 各EXCELファイルの同じ名前のシートを取り出して1つのファイルにしたいと思っています。 1つのファイルにした時、各シート名が抜き出したファイル名になるようにしたいです。 50ファイル以上ありシート数が20ある為、なんとかいい方法をお教え下さい。
- みんなの回答 (1)
- 専門家の回答
質問者が選んだベストアンサー
以下の条件で作ってみました。 1.各ファイルは同一のフォルダー内にある。 2.各ファイルはすべて閉じてある。 3.以下のマクロは各データとは別のファイルの標準モジュールに書き、同一フォルダー内に保存する。 4.そのフォルダー内には統合したいファイルと上記3で作成したファイル以外は存在しない。 5.統合されたファイルは同一ファイル内に保存される。 エクセル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)を選択して実行します。
お礼
ご回答有難う御座いました。 合体する事が出来ました。