複数エクセルブックのそれぞれシートごとを１つに合体

質問

同項目で、それぞれ入力内容の違う複数のエクセルファイル「A店」「B店」「C店」「D店」・・・と複数店分あります。
各々のファイル内に、Aマスタ、Bマスタ、Cマスタと3シートあります。（これも同項目で入力内容が違う）
これをAマスタ、Bマスタ、Cマスタというそれぞれのファイルに分けて、全店分を１つのシートに合体させたいのですが、かなりのファイル数があるので１つ１つのファイルを開き、コピー＆ペーストすると、かなりの時間が必要になります。
マクロを利用した方法はございませんでしょうか？

シートの内容詳細としては、
・各シート1～9行目までは、シートの記入方法の説明がある。
・１０行目にヘッダー
・Aマスタ、Bマスタ、Cマスタすべてヘッダーは同じ項目。

そのため、１１行目からのデータを、「A店」「B店」「C店」「D店」・・・全店分を合体させ１つのファイルにしたものを作成したいと思っています。
何かいいマクロがございましたら教えていただけますでしょうか。
マクロに関してあまり知識がございませんので、よろしくお願いいたします。

回答No.3

K Kazz（@JazzCorp） · ベストアンサー

マージ（単純結合）対象ファイル（ブック）とマクロブックは、全て同じフォルダにある。
対象シートの形式も全て同じ。
対象シートは、xFromとxToに連続したシート番号で設定する。
マージ結果は、マクロブックの同じ並びにあるシートに出力。（最初に空きのシートを用意する必要がある）

Option Explicit
Sub MergeBooksEachSheets()
Const xFileSelector = "\*.xls*"
Const xKey_Col = "A"
Const xFrom = 1
Const xTo = 3
Const xNum = xTo - xFrom + 1
Const xHeads = 10
Dim xPath As Variant
Dim xFileName As Variant
Dim xName As Variant
Dim xBook As Workbook
Dim xSheet As Worksheet
Dim xNoData As Boolean
Dim nn As Long
Dim xLast As Long
Dim zLast As Long
'Application.ScreenUpdating = False
Application.DisplayAlerts = False
xNoData = True
Set xBook = ThisWorkbook
xPath = xBook.Path & "\"
xName = xBook.Name
xFileName = Dir(xPath & xFileSelector, vbNormal)
Do Until xFileName = Empty
If (xFileName <> xName) Then
With Workbooks.Open(xPath & xFileName)
If (xNoData) Then
For nn = xFrom To xTo
xBook.Sheets(nn).UsedRange.Clear
Application.CutCopyMode = False
.Sheets(xFrom).Rows("1:" & xHeads).Copy
xBook.Sheets(nn).Range("A1").PasteSpecial Paste:=xlPasteValues '値だけを貼付け
Next
End If
For nn = xFrom To xTo
Application.CutCopyMode = False
Set xSheet = .Sheets(nn)
xLast = xSheet.Cells(Rows.Count, xKey_Col).End(xlUp).Row
xSheet.Rows(xHeads + 1 & ":" & xLast).Copy
zLast = xBook.Sheets(nn).Cells(Rows.Count, xKey_Col).End(xlUp).Row
xBook.Sheets(nn).Range("A" & zLast + 1).PasteSpecial Paste:=xlPasteValues '値だけを貼付け
Next
Application.CutCopyMode = True
.Close
End With
xNoData = False
End If
xFileName = Dir
Loop
If xNoData = True Then
MsgBox ("No Data Found!!")
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

お礼

ありがとうございます！
実行できました！！

回答No.2

tsubuyuki

> 何かいいマクロがございましたら教えていただけますでしょうか。
> マクロに関してあまり知識がございません

決してあなただけとは言いませんが、この手の質問をされる方は
見ず知らずの回答者に「こんなマクロを作ってくれ」と言う意図で
このような質問をされるのでしょうか？

処理自体は決して難しい処理ではありません。
知識が無いなら、勉強されてはいかがでしょう？

考え方は
前準備として、一つのフォルダに全店分のファイルを集めておきます。
その上で処理を考えます。

・このフォルダを指定
・一つ目の店別ブックを開く
・「Ａマスタ」シートの１１行目以降をコピー
・統合ブックに新規シートを作る
・統合ブックの新規シートに貼り付け
・新規シートの名前を変更する
・一つ目の店別ブックを閉じる
・二つ目のブックを開く
・以下、フォルダ内のブックの数だけ繰り返し

これを、Ｂ・Ｃマスタも同様に行うだけです。
繰り返し処理以外は「マクロの記録」で十分対応できる範囲です。
ＷＥＢ上に情報はいくらでも落ちていますので、
調べながら作っていくと良いですよ。

回答No.1

masatsan

良いマクロはありません。自分で作るしかないです。
障害は色々あるでしょうが、とりあえずは、新しいExcelを開いてからマクロを記録で
ファイルを開いてシートを読み込むを繰り返す。　を参考にして作ったらいかがですか。

最終的には
　新しいExcelを開いて
　追記したいファイルを探す。
　見つかったファイルを端から（for文とかで）
　　開いて、シートを指定して、１１行めから読み込む
　　前回追加したシートの最終行に追加する。
　　繰り返す

ですね。