前回・前々回で、同じフォーマットのデータがひとつのExcelの複数のシートに散らばってるのを合体するというマクロを作りました。 それに対して今回は、複数のファイル（複数のブック）を合体するというのがミッションです。 カテゴリーや担当者ごとにExcelを分けて運用すること、よくあると思いますが、そうすると面倒なのが「合体」。 「シートをまとめる」は前回やったので、今回は「ブックを合体」やってみたいと思いますが、はたして。

のっけから答え、言っちゃうわね

まず、複数のブックがあるって、こんな感じ↓ね※１～※６。

aaaa.xlsx、bbbb.xlsx、cccc.xlsx、dddd.xls、eeee.xlsxは、項目１から項目４までの４列構成で、全部同じフォーマットです。 コイツらをひとつのExcelにまとめたい。 全レコード合体。

で、今回はいきなり回答からです。 下記のマクロ、動かしてみてください。

Sub フォルダ内のエクセルを合体_1() '宣言 Dim kihonClmn As Integer Dim myPath As String Dim myFname1 As String Dim myFname2 As String Dim newbk As Workbook Dim i As Long Dim lastRw As Long '各エクセルの最終行 Dim lastRwnewbk As Long '合体の際の最終行 '基本となる列（合体の際最終行を取得する列）を設定します kihonClmn = 1 '変数取得および設定 Set newbk = Workbooks.Add() '新規ワークブックを変数に格納 myPath = ThisWorkbook.Path 'マクロの入ったブックのパスを取得 myFname1 = Dir(myPath & "\" & "*.xls*") '同フォルダ（同パス）のエクセルのファイルネームをひとつ取得 'ヘッダーをつけます '自分以外のブックをひとつ開きます If myFname1 = ThisWorkbook.Name Then 'もし自分（＝マクロの入ったブック）と同じファイルネームだったら myFname1 = Dir() 'もう１回ファイルネームを取得 End If With Workbooks.Open(myPath & "\" & myFname1) '上で取得した自分以外のファイルを開いて、アクティブにする .Activate End With '隠れた列を見せます ActiveWorkbook.Sheets(1).Columns.Hidden = False 'コピペ ActiveWorkbook.Sheets(1).Rows(1).Copy _ Destination:=newbk.Sheets(1).Cells(1, 1) '1行目（ヘッダー行）をコピーした ActiveWorkbook.Close False 'もう一度ファイル名を取得します myFname2 = Dir(myPath & "\" & "*.xls*") 'ブックを順次開いてコピペします Do Until myFname2 = "" If myFname2 = ThisWorkbook.Name Then '自分と同じファイルネームのときは、なにもしない Else With Workbooks.Open(myPath & "\" & myFname2) .Activate End With '隠れた列を見せます ActiveWorkbook.Sheets(1).Columns.Hidden = False 'フィルタがもしかかっていたら、全セル見せます If ActiveWorkbook.Sheets(1).FilterMode = True Then ActiveWorkbook.Sheets(1).ShowAllData End If lastRwnewbk = newbk.Sheets(1).Cells(Rows.Count, kihonClmn).End(xlUp).Row 'コピー先ブック（合体後のブック）の最終行を取得 lastRw = ActiveWorkbook.Sheets(1).Cells(Rows.Count, kihonClmn).End(xlUp).Row '各エクセルの最終行を取得 'コピペ If lastRw = 1 Then '最終行が1のとき（＝ヘッダーしかないとき）はなにもしない Else ActiveWorkbook.Sheets(1).Range(Rows(2), Rows(lastRw)).Copy _ Destination:=newbk.Sheets(1).Cells((lastRwnewbk + 1), 1) '2行目から取得した最終行までをコピーし貼り付け i = i + (lastRw - 1) '件数を数える End If ActiveWorkbook.Close False '開いたエクセルを保存しないで閉じる End If myFname2 = Dir() '次のエクセルのファイルネームを取得 Loop newbk.Activate MsgBox "全部で　" & i & "　件です" End Sub

下記、使い方。

1. このマクロを入れた、それだけ単独のブックをひとつ作ります（下記の例で言うと、「フォルダ内のエクセルを合体20170606.xlsm」がそれ）。

2. んで、合体したいExcel（上記の例で言うとaaaa.xlsx～eeee.xlsx）をひとつのフォルダにぶちこみます※７。 デスクトップにフォルダを作って、そこに入れるとよいでしょう。 サーバ上で動かすのはやめておいた方がよいかな。 合体するならローカルで。

3. そして、マクロを入れたブックも同フォルダに一緒に入れます。

4. そしたら、マクロ入りブックを開き、マクロを動かします※８。 他のExcelは開かなくて大丈夫です。 マクロが自動で各Excelを開いてくれますので（というか、他のExcelを開いているとエラーになる）。

で、最終的に、合体できる、と※９。

下記、このマクロの注意点。
■1行目1列目から（左上ぴっちりから）表が始まっている、というのを前提としています。 例によって例のごとく。
■フォーマットが同じでないと意味がありません。
■複数シートをもっている場合でも、各Excelのシート1しか合体できません。全ブック・全シート合体は後述。
■マクロ動かすときはローカルで。

みなさん、うまくいきましたでしょうか。

解説：変数の宣言から

このマクロ、読んでいただけるとおわかりになるでしょうが、…けっこうむずかしいですね。 はじめて登場するワードもありますし。 なので、ゆっくり見ていくことにしましょう。 まずは変数の宣言から。

【変数の宣言】
kihonClmn：kihon Column。最終行取得の基本となる列。
myPath：my Path。合体作業をするフォルダのパス。
myFname1：my File name 1。ファイル名格納用変数その１。ヘッダー作成用の捨て石。
myFname2：my File name 2。ファイル名格納用変数その２。こっちが本番。aaaa.xlsx～eeee.xlsxを格納する。
newbk：new book。合体用の新規ブックを格納。
i：件数数え用。
lastRw：last Row。aaaa.xlsx～eeee.xlsxの最終行を取得しに行く。
lastRwnewbk：last Row of new book。合体後のExcelの最終行を取得。「最終行+1」にコピペしなきゃいけないので。

変数の名前の付け方については僕の方で勝手につけてるだけなので、そこを一生懸命覚えようとしなくてもよいですよ。
名前自体は別に「aaa」でも「あああ」でもよいんです、マクロ書いてる本人がわかれば。 大事なのは考え方です。 なぜこの変数が必要なのか。 その辺りを読み解きながら、コードを読んでいってください。

さて。
kihonClmnは最終行取得の基本となる列数を入れます。 このマクロは1列目1行目から表がはじまっていることを前提としているので、「1」を入れています※10。 なので、「ウチは1列目はアキで、2列目から表が始まっているよ」という方は、この値を「2」に直してあげてください。

次。
このマクロでは「フォルダ内のExcelを順次検索して、開く」という動作をするために、「パス」を格納する変数を用意しています。 それがmyPath。
「パス」って言うのはファイルの住所みたいなものだと思ってください。 フォルダの上部のココ↓をクリックすると出てくる「C:\Users\知巳\Desktop\じっけんよう」ってのがそれね※11。 これは、「「Cドライブ」の中の、「Users」の中の、「知巳」の中の、「Desktop」の中の、「じっけんよう」ってフォルダです」って意味になります。

myFname1、myFname2には検索したファイル名を格納します。

上記パスに関連して。
上記パスを区切っている文字「\」ですが、¥（円マーク）と入力してるのに\（バックスラッシュ）と表示されたり…。
実は¥も\もPC上は同じものとして扱われてます。 ただ表示形式の違いで見え方が変わるだけですので、¥と\については「そういうものなんだな」と思うようにしてください。 深い理由は僕もよく知らないんですけど…。

ハイ、次。
newbkは新規Excelとの切替に使います。 iは総件数を数える用に。 この辺りは前回のシート合体マクロと同様ですね。
lastRwは、aaaa.xlsx～eeee.xlsxの各Excelの最終行を見に行く用に使います。 で、lastRwnewbkの方はコピペ先の合体後Excelの最終行を見に行きます。 各Excelを「最終行+1」にコピペする、というのが合体の仕組みですので※12。 この辺りも前回のシート合体マクロ同様ですね。

dir関数とは何ぞや

ではいよいよ中身です。
まず、Set newbk = Workbooks.Add()で新しくブックを追加し、それを変数に格納します※13。 この辺は前回やりましたね。 覚えていますでしょうか。

で、ここからがいよいよ新しいヤツ。 dir関数ってヤツを使います。 dir関数は、

dir(検索条件)

ってかたちで使うVBA用の関数で、もし検索条件に合致するファイルが存在すればそのファイル名を返す、というはたらきをします。 存在しなければ""（空の文字列）を返します。 これ実は、後々ループ処理させる際に地味に大事になってきます。
で、このdir関数のかっこの中、「検索条件」として「パス」と「拡張子」を指定してやれば、それに該当するファイル名が返ってくる。
今回、拡張子はワイルドカードを使って「*.xls*」とします。 こうすれば、.xlsxも、.xlsmも、.xlsも拾ってくれます。
で、「パス」は、作業するフォルダのパス、つまりマクロの入ったブックとイコールなので、まずもってmyPath = ThisWorkbook.Pathでパスを取得、そのうえでmyPath & "\" & "*.xls*"（\はパスの区切り文字）としてdir関数の引数に入れてやります※14。

…ちょっとむずかしいかな？
まあ、とりあえずこのかたちで覚えちゃう、というのもひとつの手です。 使ってみて、後々理解が追いついてくる、ということもありますし。 でもまあ、わからないながらも一度解説文を読んでおく、というのもひとつの経験です。 なので、いちおうは最後までお付き合い願えると幸いです。
さて。
dir関数の仕様というか特徴なんですが、dir関数はファイル名を1コずつ拾います。 なので、

dir関数でファイル名を拾う
↓
拾ったファイル名のExcelをオープン→コピペ
↓
再びdir関数でファイル名を拾う
↓
（以下ループ）

という手順でループさせれば、フォルダ内のExcelを次々開いていってコピペできるのでは。 これが今回のマクロの基本的な考え方です。
だから下記で、ファイルを開き、コピペし、そのファイルを閉じています※15。

ファイルを開くときは.Open()、閉じるには.Closeを使います。 .Closeの後ろのFalseは「保存しないで閉じる」の意味です。 単に閉じるだけだったら.Closeだけでもよいんですが、そうすると閉じる際に「変更を保存しますか？」とExcelに聞かれちゃいます。 別に１回聞かれるぐらいだったらそんなに面倒でもないのですが、…今回のように「次々開いて、閉じる」系のマクロだといちいち閉じるたびに聞かれちゃうので、「保存しないで閉じる」ようにあらかじめ命令してあげます。
もし「保存して、閉じる」をやりたい場合は、

ブック名.Save
ブック名.Close

としてやると、「保存して、閉じる」を実行できますよ。

さて。
このマクロは大きく２つのパートに分かれていて、最初のパートはヘッダー部分（１行目）をもってくるだけ。 本番はループ処理のところになります※16。

で、ループ処理のところ。
最初にmyFname2 = Dir(myPath & "\" & "*.xls*")でファイル名を取得するのですが、その後は引数を省略しmyFname2 = Dir()だけで次のファイル名を取得してくれます※17。 だから次々ファイルを開ける、というワケ。

ただし、Excelを順次開いていくと自分自身（＝マクロ入りブック）も拾ってしまうので、「もし自分と同じファイル名だったら何もしない」ようif文で逃がしてあげます※18。

で、そうやって次々ファイル名をひろっていって、全部ひろい終えた＝myFname2が空になるので、そのときループは終了する、と。
こういう具合になっています。

…うん、じゃあちょっとここらで、dir関数の特徴がわかるような練習用マクロを書いてみたので、動かしてみてください。 下記マクロを入れたブックを適当なフォルダに入れてマクロを動かすと、フォルダ内のファイル名を次々メッセージボックスに表示させることができます※19。

Sub ファイル名取得れんしゅう() Dim myPath As String Dim myFname As String Dim i As Integer myPath = ThisWorkbook.Path 'マクロの入ったエクセルのパスを取得　同じパス（同じフォルダ）を検索できるようにする myFname = Dir(myPath & "\" & "*") 'マクロの入ったエクセルと同フォルダ（同パス）のファイルネームをひとつ取得 MsgBox myFname '１つ目のファイル名が表示されます myFname = Dir() '次のファイル名を取得します MsgBox myFname '２つ目のファイル名が表示されます myFname = Dir() 'さらに次のファイル名を取得します MsgBox myFname '３つ目のファイル名が表示されます myFname = Dir(myPath & "\" & "*") '再度初めからファイル名を取得します MsgBox myFname '１つ目のファイル名が表示されます '同パス内の全ファイルを取得してみます MsgBox "これから、全ファイル名を取得します" i = 0 myFname = Dir(myPath & "\" & "*") '再度初めからファイル名を取得します Do Until myFname = "" 'dir関数の結果が空になるまで＝ファイル名を全部取得するまでループさせます MsgBox myFname i = i + 1 myFname = Dir() Loop MsgBox "フォルダ内のファイル名をすべて表示しました。 全部で " & i & " ファイルです。" End Sub

マクロの中身については、マクロ本文に詳細にコメントを残したのでそれを読んでいただければ挙動はわかるかな、と※20。

このサンプルは、
■Dir関数を使うとファイル名を取得できる
■引数省略のDir()を使う：次のファイル名を取得
■引数を入れ直す：ふりだしに戻る
ってことをわかってもらうためのマクロです。 なので、その点が理解できればOK※21。

ということで、だいたい解説できた、かな？

1行目1列目から始まっていない表にも対応できるよう工夫する

じゃあ、だいたい説明は済んだかと思うので、次いっちゃうよ。 「ちょっとまだ不安だな…」って人は、マクロにコメントを残してあるので、そこもしっかり読んで、読み解いてみてください。

ということで、次。 さっきのマクロをちょっと改良して。
上のマクロは「1列目1行目から表がはじまっている」のが前提でした。 そこを、「2列目2行目から」とか「2列目3行目から」などに柔軟に対応できるようにしたのが下↓のマクロです。

Sub フォルダ内のエクセルを合体_2() '宣言 Dim kihonClmn As Integer Dim hedderRw As Integer Dim myPath As String Dim myFname1 As String Dim myFname2 As String Dim newbk As Workbook Dim i As Long Dim lastRw As Long '各エクセルの最終行 Dim lastRwnewbk As Long '合体の際の最終行 '基本となる列（合体の際最終行を取得する列）を設定します 'インプットボックスに列番号を入れます kihonClmn = Application.InputBox _ (prompt:="全セル入力されている列を番号で指定してください" & Chr(13) & "デフォルトは「1」列目です", _ Title:="列番号の指定", Default:=1, Type:=1) 'インプットボックスに「何行目から表が始まるか」を入れます hedderRw = Application.InputBox _ (prompt:="ヘッダー行の行数値を入れてください" & Chr(13) & "デフォルトは「1」行目です", _ Title:="行番号の指定", Default:=1, Type:=1) 'もしどちらかにゼロが入力されたら停止します If kihonClmn <= 0 Or hedderRw <= 0 Then MsgBox "プロシージャを中止します" Exit Sub End If '変数取得および設定 Set newbk = Workbooks.Add() '新規ワークブックを変数に格納 myPath = ThisWorkbook.Path 'マクロの入ったブックのパスを取得 myFname1 = Dir(myPath & "\" & "*.xls*") '同フォルダ（同パス）のエクセルのファイルネームをひとつ取得 'ヘッダーをつけます '自分以外のブックをひとつ開きます If myFname1 = ThisWorkbook.Name Then 'もし自分（＝マクロの入ったブック）と同じファイルネームだったら myFname1 = Dir() 'もう１回ファイルネームを取得 End If With Workbooks.Open(myPath & "\" & myFname1) '上で取得した自分以外のファイルを開いて、アクティブにする .Activate End With '隠れた列を見せます ActiveWorkbook.Sheets(1).Columns.Hidden = False 'コピペ ActiveWorkbook.Sheets(1).Rows(hedderRw).Copy _ Destination:=newbk.Sheets(1).Cells(hedderRw, 1) 'ヘッダー行をコピーした ActiveWorkbook.Close False 'もう一度ファイル名を取得します myFname2 = Dir(myPath & "\" & "*.xls*") 'ブックを順次開いてコピペします Do Until myFname2 = "" If myFname2 = ThisWorkbook.Name Then '自分と同じファイルネームのときは、なにもしない Else With Workbooks.Open(myPath & "\" & myFname2) .Activate End With '隠れた列を見せます ActiveWorkbook.Sheets(1).Columns.Hidden = False 'フィルタがもしかかっていたら、全セル見せます If ActiveWorkbook.Sheets(1).FilterMode = True Then ActiveWorkbook.Sheets(1).ShowAllData End If lastRwnewbk = newbk.Sheets(1).Cells(Rows.Count, kihonClmn).End(xlUp).Row 'コピー先ブック（合体後のブック）の最終行を取得 lastRw = ActiveWorkbook.Sheets(1).Cells(Rows.Count, kihonClmn).End(xlUp).Row '各エクセルの最終行を取得 'コピペ If lastRw <= hedderRw Then '最終行がヘッダー行以下のときはなにもしない Else ActiveWorkbook.Sheets(1).Range(Rows(hedderRw + 1), Rows(lastRw)).Copy _ Destination:=newbk.Sheets(1).Cells((lastRwnewbk + 1), 1) 'ヘッダー行の次の行から取得した最終行までをコピーし貼り付け i = i + (lastRw - hedderRw) '件数を数える End If ActiveWorkbook.Close False '開いたエクセルを保存しないで閉じる End If myFname2 = Dir() '次のエクセルのファイルネームを取得 Loop newbk.Activate MsgBox "全部で　" & i & "　件です" End Sub

たとえばこんなふうに、2列目2行目からはじまってる表でも…※22。

「2列目から」「2行目から」とインプットボックスに入れてやれば、そのフォーマットで合体します※23　※24。

元のマクロからの主な変更点は下記↓※25　※26。

デフォルトの数値に「1」を設定してあるので、従来どおり1列目1行目からはじまる表でも合体できますよ。
（もちろん、全ブックが同じフォーマットでないとダメですよ。 「この表は1列目1行目から、次のは2列目3行目から…」ってのは無理です。）

おまけ：全ブックの全シートを巡回する

最後に。
各ブックにふくまれるすべてのシートを巡回して合体するマクロについても作ってみました※27　※28。

Sub フォルダ内のエクセルを合体_3_全シート巡回() '宣言 Dim kihonClmn As Integer Dim hedderRw As Integer Dim myPath As String Dim myFname1 As String Dim myFname2 As String Dim newbk As Workbook Dim i As Long Dim lastRw As Long '各エクセルの最終行 Dim lastRwnewbk As Long '合体の際の最終行 Dim mySh As Integer 'シート巡回用 '基本となる列（合体の際最終行を取得する列）を設定します 'インプットボックスに列番号を入れます kihonClmn = Application.InputBox _ (prompt:="全セル入力されている列を番号で指定してください" & Chr(13) & "デフォルトは「1」列目です", _ Title:="列番号の指定", Default:=1, Type:=1) 'インプットボックスに「何行目から表が始まるか」を入れます hedderRw = Application.InputBox _ (prompt:="ヘッダー行の行数値を入れてください" & Chr(13) & "デフォルトは「1」行目です", _ Title:="行番号の指定", Default:=1, Type:=1) 'もしどちらかにゼロが入力されたら停止します If kihonClmn <= 0 Or hedderRw <= 0 Then MsgBox "プロシージャを中止します" Exit Sub End If '変数取得および設定 Set newbk = Workbooks.Add() '新規ワークブックを変数に格納 myPath = ThisWorkbook.Path 'マクロの入ったブックのパスを取得 myFname1 = Dir(myPath & "\" & "*.xls*") '同フォルダ（同パス）のエクセルのファイルネームをひとつ取得 'ヘッダーをつけます '自分以外のブックをひとつ開きます If myFname1 = ThisWorkbook.Name Then 'もし自分（＝マクロの入ったブック）と同じファイルネームだったら myFname1 = Dir() 'もう１回ファイルネームを取得 End If With Workbooks.Open(myPath & "\" & myFname1) '上で取得した自分以外のファイルを開いて、アクティブにする .Activate End With '隠れた列を見せます ActiveWorkbook.Sheets(1).Columns.Hidden = False 'コピペ ActiveWorkbook.Sheets(1).Rows(hedderRw).Copy _ Destination:=newbk.Sheets(1).Cells(hedderRw, 1) 'ヘッダー行をコピーした ActiveWorkbook.Close False 'もう一度ファイル名を取得します myFname2 = Dir(myPath & "\" & "*.xls*") '大きいループ　ブックを開く用 Do Until myFname2 = "" If myFname2 = ThisWorkbook.Name Then '自分と同じファイルネームのときは、なにもしない Else With Workbooks.Open(myPath & "\" & myFname2) .Activate End With '小さいループ　ブック内の各シートを巡回 mySh = 1 'シート巡回用に数値を設定 Do Until mySh > Sheets.Count Sheets(mySh).Activate '隠れた列を見せます ActiveWorkbook.Sheets(mySh).Columns.Hidden = False 'フィルタがもしかかっていたら、全セル見せます If ActiveWorkbook.Sheets(mySh).FilterMode = True Then ActiveWorkbook.Sheets(mySh).ShowAllData End If lastRwnewbk = newbk.Sheets(1).Cells(Rows.Count, kihonClmn).End(xlUp).Row 'コピー先ブック（合体後のブック）の最終行を取得 lastRw = ActiveWorkbook.Sheets(mySh).Cells(Rows.Count, kihonClmn).End(xlUp).Row '各エクセルの最終行を取得 'コピペ If lastRw <= hedderRw Then '最終行がヘッダー行以下のときはなにもしない Else ActiveWorkbook.Sheets(mySh).Range(Rows(hedderRw + 1), Rows(lastRw)).Copy _ Destination:=newbk.Sheets(1).Cells((lastRwnewbk + 1), 1) 'ヘッダー行の次の行から取得した最終行までをコピーし貼り付け i = i + (lastRw - hedderRw) '件数を数える End If mySh = mySh + 1 Loop '小さいループ終わり ActiveWorkbook.Close False '開いたエクセルを保存しないで閉じる End If myFname2 = Dir() '次のエクセルのファイルネームを取得 Loop newbk.Activate MsgBox "全部で　" & i & "　件です" End Sub

作り方は、前回の「シート合体マクロ」との合わせ技です。 要するに、ループ処理を２回行い、ブックを開くループ（大ループ）の中に、各シートを見に行くループ（小ループ）を入れ子にする、という※29。

いかがでしたでしょうか。
「ブックを次々開く」の仕組みが分かれば、これ以外にも、「ブックを次々開いて、印刷設定を行い、プリントする」とか「ブックを次々開いて、更新して、保存して閉じる」とか応用が利くと思いますので。
ではでは、シーユーアゲン！