複数ファイルを自動で1シートにまとめることができる!
複数ファイルを1シートにまとめるマクロツールをご紹介します。
エクセルファイルをダウンロードしてすぐに使えます。
ボタンを押してまとめるファイルの保存先を設定するだけで
たくさんのワークブックファイルでも1シートにまとめたファイルがすぐに作成できます。
※複数ファイルをシートごとに分けてまとめたい場合はこちらをクリック
※その他の集計ツールはこちらをクリック
操作画面
手順
※まとめるファイルはすべて閉じてから作業してください。
【まとめたいファイルの注意点】
・非表示シートも再表示し作業されます。
・拡張子はxls,xlsx,xlsmすべて対象になります。
・各シートの1行目はデータ名を記入してください。
データが存在する列の1行目は空欄を作らないで下さい。
データは左詰めで作成してください。
2行目からのデータをまとめます。
・シート名、シート数、ファイル数はマクロ上の制限はありません。
①1つにまとめたいファイルを1つのフォルダに保存する
②【複数ファイルを1シートにまとめる】ボタンを押す
③ダイアログから作業フォルダを選択
作業が完了すると作業フォルダの中にAllReports.xlsxが作成されます。
作業したフォルダ名がD2セルに記入されます。
集約されたデータの最終列にファイル名とシート名が記入されます。
↓
【注意】
・このマクロファイルは集約ファイルと同じ場所には保存しないで下さい。
・また、マクロファイルと同じ名前のファイルと同じ場所には保存しないで下さい。
はじめまして。泉と申します。
複数ファイルを1シートにまとめるマクロを採用したいのですが、
各ファイルの1シート目だけをまとめたいのですが、どうすればよろしいでしょうか?
ご教示いただけると助かります。
よろしくお願いいたします。
ご連絡ありがとうございます。
1シート目のみまとめるマクロへの修正方法ですが
「’データを1シートにまとめる」(「’コピー元ファイルを閉じる」の前まで)を
以下のように修正して下さい。
(1)For i = 1 To Worksheets.Count
Next i
を削除
(2)With Worksheets(i) を
With Worksheets(1) に修正
もしわからなかったら、以下のように貼り替えてください。
‘データを1シートにまとめる
sWB.Activate
With Worksheets(1)
lRow = .Cells(Rows.Count, 1).End(xlUp).Row
lCol = .Cells(1, Columns.Count).End(xlToLeft).Column
‘シートのデータが2行以上の場合にコピー
If lRow >= 2 Then
dWB.Activate
lRow2 = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1
.Activate
.Range(Cells(2, 1), Cells(lRow, lCol)).Copy dWB.Worksheets(1).Cells(lRow2, 1)
dWB.Worksheets(1).Activate
Maxrow = Cells(Rows.Count, 1).End(xlUp).Row
Worksheets(1).Range(Cells(lRow2, Maxcol + 1), Cells(Maxrow, Maxcol + 1)).Value = sWB.Name
Worksheets(1).Range(Cells(lRow2, Maxcol + 2), Cells(Maxrow, Maxcol + 2)).Value = .Name
End If
End With
うまくできない場合はファイルを新たにアップ致しますのでご連絡下さい。
はじめまして。
複数ファイルを一つにまとめるマクロをありがとうございます。
AB列だけの複数ファイルファイルを一つのシートにまとめる際に
最初のファイルはAB列、次のファイルはCD列….という風に複数のファイルをで横並びにまとめるにはどうしたらよろしいでしょうか?
はじめまして。
ご連絡ありがとうございます。
貴重なご意見ありがとうございます。
ご希望のマクロは今作成してあるマクロの中にはありませんが
ご希望であればお時間頂ければ作成可能です。
その際はこちらのサイトにアップ致します。
よろしくお願い致します。
大変有用なコード有難うございました。
集約されたデータの最終列にファイル名とシート名が記入されますが、それぞれを転記されない方法をご教示
頂ければと思います。
宜しくお願いします。
ご連絡ありがとうございます。
以下を削除していただければファイル名、シート名は記入されません。
よろしくお願い致します。
Worksheets(1).Range(Cells(lRow2, Maxcol + 1), Cells(Maxrow, Maxcol + 1)).Value = sWB.Name
Worksheets(1).Range(Cells(lRow2, Maxcol + 2), Cells(Maxrow, Maxcol + 2)).Value = .Name
クラウド上では、動作しないようですが、何か方法はありますか?
返信遅くなりました。
クラウド上でマクロを実行は難しいようで私にはわかり兼ねます。
お力になれず申し訳まりません。
はじめまして。集計元のデータがA1セルからではなく例えばB10セルの場合、どこを修正すれば動くようになりますか。
「’列見出しをコピー」の下と「’データを1シートにまとめる」の下を「A1」からではなく「B10」に合わせて修正すれば動くと思います。
難しければ、ファイルを開くときに「A1」からの仕様に合うように9行目まで削除とA列を削除する文を追加した方が早いかもしれません。
結合したセルをコピーする場合はどうすればいいでしょうか
また複数のセルを同時に行う場合も知りたいです
‘指定したフォルダ内にあるブックのファイル取得
sFile = Dir(SOURCE_DIR & “*.xls*”)
上記部分でエラーになってしまいます、、。
返信が遅くなりまして申し訳ありません。
私の環境では問題なく動きますのでエラーの原因はわかり兼ねます。
お力になれず申し訳ありません。
すいません、教えてください。
【複数ファイルを1シートにまとめる】マクロを使わえていただいていますが、
1ファイルに複数のシートがある場合、最初のシートのみを取り込みたいんですが、
どこを変更すればよいでしょうか?
下記の辺りを色々触ってみましたが、上手く行かず・・・ご教授いただけないでしょうか?
宜しくお願いします。
「 For i = 1 To Worksheets.Count
sWB.Activate
With Worksheets(i)
lRow = .Cells(Rows.Count, 1).End(xlUp).Row
lCol = .Cells(1, Columns.Count).End(xlToLeft).Column
‘シートのデータが2行以上の場合にコピー
If lRow >= 2 Then
dWB.Activate
lRow2 = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1
.Activate
.Range(Cells(2, 1), Cells(lRow, lCol)).Copy dWB.Worksheets(1).Cells(lRow2, 1)
dWB.Worksheets(1).Activate
Maxrow = Cells(Rows.Count, 1).End(xlUp).Row
Worksheets(1).Range(Cells(lRow2, Maxcol + 1), Cells(Maxrow, Maxcol + 1)).Value = sWB.Name
Worksheets(1).Range(Cells(lRow2, Maxcol + 2), Cells(Maxrow, Maxcol + 2)).Value = .Name」
返信が遅くなりまして申し訳ありません。
以下の部分を置き換えれば1シート目のみ取得されると思います。
お手数お掛け致しますがよろしくお願い致します。
‘データを1シートにまとめる
sWB.Activate
With Worksheets(1)
lRow = .Cells(Rows.Count, 1).End(xlUp).Row
lCol = .Cells(1, Columns.Count).End(xlToLeft).Column
‘シートのデータが2行以上の場合にコピー
If lRow >= 2 Then
dWB.Activate
lRow2 = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1
.Activate
.Range(Cells(2, 1), Cells(lRow, lCol)).Copy dWB.Worksheets(1).Cells(lRow2, 1)
dWB.Worksheets(1).Activate
Maxrow = Cells(Rows.Count, 1).End(xlUp).Row
Worksheets(1).Range(Cells(lRow2, Maxcol + 1), Cells(Maxrow, Maxcol + 1)).Value = sWB.Name
Worksheets(1).Range(Cells(lRow2, Maxcol + 2), Cells(Maxrow, Maxcol + 2)).Value = .Name
End If
End With
‘コピー元ファイルを閉じる
すいません、列が非表示のファイルを再表示して取り込みたいんですが、
上手く行かないので、ご教授お願いできますでしょうか。
最初のシートのみ取り込み、行列の再表示をしたい場合は以下のコードに置き換えて頂ければと思います。
お手数お掛け致しますがよろしくお願い致します。
‘データを1シートにまとめる
sWB.Activate
With Worksheets(1)
.Rows.Hidden = False ‘行再表示
.Columns.Hidden = False ‘列再表示
lRow = .Cells(Rows.Count, 1).End(xlUp).Row
lCol = .Cells(1, Columns.Count).End(xlToLeft).Column
‘シートのデータが2行以上の場合にコピー
If lRow >= 2 Then
dWB.Activate
lRow2 = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1
.Activate
.Range(Cells(2, 1), Cells(lRow, lCol)).Copy dWB.Worksheets(1).Cells(lRow2, 1)
dWB.Worksheets(1).Activate
Maxrow = Cells(Rows.Count, 1).End(xlUp).Row
Worksheets(1).Range(Cells(lRow2, Maxcol + 1), Cells(Maxrow, Maxcol + 1)).Value = sWB.Name
Worksheets(1).Range(Cells(lRow2, Maxcol + 2), Cells(Maxrow, Maxcol + 2)).Value = .Name
End If
End With
‘コピー元ファイルを閉じる
こちら、ありがたく使用させていただいております。
特定のシート(例えば”報告書”)のみまとめる場合にはどうしたらいいでしょうか。
以下を触ってみましたがうまくいかないです。(初心者です)
‘データを1シートにまとめる
sWB.Activate
With Worksheets(”報告書”)
.Rows.Hidden = False ‘行再表示
.Columns.Hidden = False ‘列再表示
lRow = .Cells(Rows.Count, 1).End(xlUp).Row
lCol = .Cells(1, Columns.Count).End(xlToLeft).Column
‘シートのデータが2行以上の場合にコピー
If lRow >= 2 Then
dWB.Activate
lRow2 = Worksheets(”報告書”).Cells(Rows.Count, 1).End(xlUp).Row + 1
.Activate
.Range(Cells(2, 1), Cells(lRow, lCol)).Copy dWB.Worksheets(1).Cells(lRow2, 1)
dWB.Worksheets(1).Activate
Maxrow = Cells(Rows.Count, 1).End(xlUp).Row
Worksheets(”報告書”).Range(Cells(lRow2, Maxcol + 1), Cells(Maxrow, Maxcol + 1)).Value = sWB.Name
Worksheets(”報告書”).Range(Cells(lRow2, Maxcol + 2), Cells(Maxrow, Maxcol + 2)).Value = .Name
End If
End With
‘コピー元ファイルを閉じる
よろしくお願いいたします。
返信が遅くなりまして申し訳ありません。
‘データを1シートにまとめるの下の部分の
For i = 1 To Worksheets.Count~Next iを削除して
With Worksheets(i)をWith Worksheets(“報告書”)に変更してみてはいかがでしょうか?
よろしくお願いいたします。