※統合する（マージする）イメージ
Excelでフォルダ内にある複数のファイルを1つのブックのシート別にまとめたいことがあります。
その方法をまとめてみました。
複数のファイルを1つのブックに集約する
たとえば、フォルダ内にこういった複数のファイルがあって、
集計やチェックのために、
「1つのブックでシート別にまとめたい」
「Excelだけ（CSVだけ）をまとめたい」
ということがあります。
こういうときにチカラ技でやるとすると、「ファイルを開いてコピペして…」を繰り返さざるを得ません。
コピペを繰り返さないなら、マクロを使うことになります。
マクロについては、過去に記事にしているものもあります。
で、今回はフォルダ内の複数ファイル（Excel・CSV）をコピーして1つのExcelブックにシートを分けて貼り付けることで、1つのブックに統合するマクロです。
統合したいファイル（データの拡張子）をあらかじめ選んでおき、
フォルダを指定するボタンで、統合したいファイルが入っているフォルダを指定しておき、
結合ボタンを押せば、指定したフォルダ内の複数のファイル（かつ、すべてのシート）を1つのExcelブックでシートを分けて統合することができます。
フォルダ内にいくつファイルがあってもやり方は同じです。
フォルダ内のExcel・CSVを1つのブックでシート別に統合するマクロ
マクロはこういったコードです。
Sub folder()
If Application.FileDialog(msoFileDialogFolderPicker).Show = True Then
Range("B2").Value = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
End If
End Sub
Sub allsheetcopyandmerge()
Dim フォルダパス As String
Dim ファイルフィルタ As String
Dim ファイル名 As String
Dim 元ブック As Workbook
Dim 新ブック As Workbook
Dim 新シート As Worksheet
Dim 元シート As Worksheet
Dim 新シート名 As String
Dim 拡張子 As String
Dim i As Integer
' パスとフィルター取得
フォルダパス = ThisWorkbook.Sheets(1).Range("B2").Value
If Right(フォルダパス, 1) <> "\" Then フォルダパス = フォルダパス & "\"
ファイルフィルタ = ThisWorkbook.Sheets(1).Range("B1").Value
If ファイルフィルタ = "" Then
MsgBox "B1に拡張子フィルター（例：*.xlsx）を入力してください", vbExclamation
Exit Sub
End If
' 新しいブック作成
Set 新ブック = Workbooks.Add
'' 最初のシートを除いて削除
Application.DisplayAlerts = False
Do While 新ブック.Sheets.Count > 1
新ブック.Sheets(2).Delete
Loop
Application.DisplayAlerts = True
' ファイルループ
ファイル名 = Dir(フォルダパス & ファイルフィルタ)
Do While ファイル名 <> ""
If ファイル名 <> ThisWorkbook.Name Then
拡張子 = LCase(Right(ファイル名, Len(ファイル名) - InStrRev(ファイル名, ".")))
' ブックを開く
Set 元ブック = Workbooks.Open(Filename:=フォルダパス & ファイル名, ReadOnly:=True)
' 各シートを処理
For Each 元シート In 元ブック.Sheets
元シート.UsedRange.copy
' 新しいシート追加
Set 新シート = 新ブック.Sheets.Add(After:=新ブック.Sheets(新ブック.Sheets.Count))
' シート名を「ファイル名_シート名」にする（31文字以内）
新シート名 = Left(Replace(ファイル名, "." & 拡張子, "") & "_" & 元シート.Name, 31)
' 重複を防ぐ
i = 1
Do While シート名重複(新ブック, 新シート名)
新シート名 = Left(新シート名, 28) & "_" & i
i = i + 1
Loop
新シート.Name = 新シート名
' 貼り付け
新シート.Range("A1").PasteSpecial xlPasteAll
Next 元シート
元ブック.Close SaveChanges:=False
End If
ファイル名 = Dir()
Loop
Application.CutCopyMode = False
MsgBox "統合完了！", vbInformation
End Sub
' シート名の重複チェック用関数
Function シート名重複(対象ブック As Workbook, シート名 As String) As Boolean
Dim ws As Worksheet
シート名重複 = False
For Each ws In 対象ブック.Sheets
If ws.Name = シート名 Then
シート名重複 = True
Exit Function
End If
Next
End Functionまず冒頭部分で、フォルダを指定するコードを書いています。
Sub folder()
If Application.FileDialog(msoFileDialogFolderPicker).Show = True Then
Range("B2").Value = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
End If
End Subフォルダ指定のボタンを押すことでこのマクロが動き、指定したフォルダ名をB2セルに表示し、それを次のマクロで使っていきます。
ボタンの作り方はこちらの記事を参考にしていただければ。
この部分では、B2セルで指定したフォルダの場所とB1セルで指定したファイルの種類（ExcelかCSVか）からコピペする対象を特定しています。
' パスとフィルター取得
フォルダパス = ThisWorkbook.Sheets(1).Range("B2").Value
If Right(フォルダパス, 1) <> "\" Then フォルダパス = フォルダパス & "\"
ファイルフィルタ = ThisWorkbook.Sheets(1).Range("B1").Value
If ファイルフィルタ = "" Then
MsgBox "B1に拡張子フィルター（例：*.xlsx）を入力してください", vbExclamation
Exit Sub
End Ifその後に、統合先の新規ブックをひらき、前述のフォルダ内にあるファイルを開いて各シートをコピペする処理を繰り返します。
コピペ元のファイルの数やシートの数が増えても、統合先の新規ブックにコピペできるように、シートを追加していく必要があります。
' 新しいシート追加
Set 新シート = 新ブック.Sheets.Add(After:=新ブック.Sheets(新ブック.Sheets.Count))それと、シートの名前には字数制限（31文字）があります。新規ブックのシート名を、「コピペ元のブック名＋シート名」とする場合、これに引っかかるとエラーになるので、Left～,31）で長くても31字までになるようにシート名をつける必要もあります。
' シート名を「ファイル名_シート名」にする（31文字以内）
新シート名 = Left(Replace(ファイル名, "." & 拡張子, "") & "_" & 元シート.Name, 31)それに新規ブックのシートの名前が重複するような場合には違う名前にしておかないとエラーになります。
なので、最後の部分（Function シート名重複）で関数を定義しておき、
' シート名の重複チェック用関数
Function シート名重複(対象ブック As Workbook, シート名 As String) As Boolean
Dim ws As Worksheet
シート名重複 = False
For Each ws In 対象ブック.Sheets
If ws.Name = シート名 Then
シート名重複 = True
Exit Function
End Ifコピペを繰り返す部分では、「Do While」のところで、この関数を呼び出して重複をチェックしている流れです。
' 重複を防ぐ
i = 1
Do While シート名重複(新ブック, 新シート名)
新シート名 = Left(新シート名, 28) & "_" & i
i = i + 1コードでは、シート名の末尾に「_1」～「_10」などを連番を付け足せるように28字で区切っておき、最後の3文字分は確保しておきます。
というような、人がやるとあたり前に手を動かしてやるようなことでも、ちゃんと書かないやってもらえないという点は、プログラミングならではです。人に対する伝え方でも共通することはありますし、いい勉強になります。
で、このような処理（ファイルを開く→新規ブックのシートにコピペする→ファイルを閉じる）を繰り返すという流れです。
' ファイルループ
ファイル名 = Dir(フォルダパス & ファイルフィルタ)
Do While ファイル名 <> ""
If ファイル名 <> ThisWorkbook.Name Then
拡張子 = LCase(Right(ファイル名, Len(ファイル名) - InStrRev(ファイル名, ".")))
' ブックを開く
Set 元ブック = Workbooks.Open(Filename:=フォルダパス & ファイル名, ReadOnly:=True)
' 各シートを処理
For Each 元シート In 元ブック.Sheets
元シート.UsedRange.copy
' 新しいシート追加
Set 新シート = 新ブック.Sheets.Add(After:=新ブック.Sheets(新ブック.Sheets.Count))
' シート名を「ファイル名_シート名」にする（31文字以内）
新シート名 = Left(Replace(ファイル名, "." & 拡張子, "") & "_" & 元シート.Name, 31)
' 重複を防ぐ
i = 1
Do While シート名重複(新ブック, 新シート名)
新シート名 = Left(新シート名, 28) & "_" & i
i = i + 1
Loop
新シート.Name = 新シート名
' 貼り付け
新シート.Range("A1").PasteSpecial xlPasteAll
Next 元シート
元ブック.Close SaveChanges:=False
End If
ファイル名 = Dir()
Loop
この完了メッセージはいらないかもしれませんが一応。他のことをやっていて忘れてしまうかもしれませんので。
MsgBox "統合完了！", vbInformation今回のサンプル（ダウンロード）はこちらです。
SOU_サンプル | フォルダ内の複数ファイル（全シート）を1つのブックに統合するマクロ
ファイルの受け取り方（仕事の入口）は大事
今回のマクロ、ChatGPTなどでコードを書いてもらうことはできますし、わたしも書いてみたコードをチェックしてもらうことはあります。それで勉強できることは多いです。「こういう書き方もありますよ」とアドバイスもくれますし。
こういった生成AI。使い方を工夫できれば、確かに便利で使わない手はないでしょう。
とはいえです。
そもそものデータの受け取り方（入口部分）で工夫できることはないのかはやっておくべきでしょう。
今回の例でいうと、「1つのブック内でシート別に統合されているデータ」を受け取れていれば、やらずに済むわけですから（とはいえ、今回はどうしようもなかった実情もあり…）。
たとえば、ネットからデータをダウンロードできたとしても、そのままでは使えないケースもよくあります。
そうなると、「ダウンロードして、統合して、まとめて…」となることも多く、データを使えるまでがタイヘンです。
ZIPファイルともなると、これまたタイヘンです。ダブルクリックしないと見れませんから。
これにパスワードがかかっていたら、それを入力しないとなりません。
入力しても開かないとなると、どちらかでパスワードが違っている可能性があります。となるとそこからやり直さないとなりません。
クラウドストレージ（Dropboxなど）を使っておけばフォルダやファイルも共有できます。ファイルをメールに添付する必要もないですし、パスワードでやりとりする必要もなくなります。
メールにファイルを添付しても、同じアドレス宛にパスワードを送ってもセキュリティ面でさほど効果はないでしょう。
ということを考えてみても、入口を整えるべく工夫しておくことは大事です。
その後の仕事のやり方、流れにも大きく影響することですから。
マクロで手を動かして、自分好みのカスタマイズができるのも確かにメリットかもしれませんが、はじめからきれいで整ったデータであることに越したことはありません。
プログラミングなど効率化の勉強は続けていかねばなりませんが、それとは別に入口のところで工夫の余地はないのかも意識しておきたいことです。
■編集後記
昨日は朝タスク、息子を学校へ送り、車椅子の修理で真駒内まで。午後はカフェで仕事を。何度か利用しているカフェです。はじめて座ってみたコアワーキング用の席はちょっと落ち着かず…（個人的にダメっぽいです）。
■昨日の1日1新
・そば処盛朗庵
・桜ムースのチーズケーキ（宮田屋珈琲）
・とある研究
■息子（11歳）
昨日は学校と放課後デイの日。デイの帰りの車内で嫌なことがあったようで家に到着してからもしばらく不機嫌モードの息子。理由を聞いてみると、「そりゃしかたないわ…」というもの。とりあえず夕食のトンカツはたくさん食べて気持ちもリセットできたみたいです。
