複数ファイルを1シートにまとめるマクロ

複数ファイルを自動で1シートにまとめることができる!
複数ファイルを1シートにまとめるマクロツールをご紹介します。
エクセルファイルをダウンロードしてすぐに使えます。

ボタンを押してまとめるファイルの保存先を設定するだけで
たくさんのワークブックファイルでも1シートにまとめたファイルがすぐに作成できます。

※複数ファイルをシートごとに分けてまとめたい場合はこちらをクリック

※その他の集計ツールはこちらをクリック

操作画面

手順    

まとめるファイルはすべて閉じてから作業してください。

【まとめたいファイルの注意点】

・非表示シートも再表示し作業されます。

・拡張子はxls,xlsx,xlsmすべて対象になります。

・各シートの1行目はデータ名を記入してください。
データが存在する列の1行目は空欄を作らないで下さい。
データは左詰めで作成してください。
2行目からのデータをまとめます。

・シート名、シート数、ファイル数はマクロ上の制限はありません。

①1つにまとめたいファイルを1つのフォルダに保存する

複数ファイルを1シートにまとめるボタンを押す

③ダイアログから作業フォルダを選択

作業が完了すると作業フォルダの中にAllReports.xlsxが作成されます。

作業したフォルダ名がD2セルに記入されます。

集約されたデータの最終列にファイル名とシート名が記入されます。

                 

【注意】

・このマクロファイルは集約ファイルと同じ場所には保存しないで下さい。
・また、マクロファイルと同じ名前のファイルと同じ場所には保存しないで下さい。

↓ダウンロードはこちらをクリック(詳しい手順、注意事項はファイルの中に記載)

複数ファイルを1シートにまとめるマクロ」への17件のフィードバック

  1. はじめまして。泉と申します。
    複数ファイルを1シートにまとめるマクロを採用したいのですが、
    各ファイルの1シート目だけをまとめたいのですが、どうすればよろしいでしょうか?
    ご教示いただけると助かります。
    よろしくお願いいたします。

    返信
    1. macro 投稿作成者

      ご連絡ありがとうございます。
      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

      うまくできない場合はファイルを新たにアップ致しますのでご連絡下さい。

      返信
  2. 塚田英幸

    はじめまして。
    複数ファイルを一つにまとめるマクロをありがとうございます。

    AB列だけの複数ファイルファイルを一つのシートにまとめる際に
    最初のファイルはAB列、次のファイルはCD列….という風に複数のファイルをで横並びにまとめるにはどうしたらよろしいでしょうか?

    返信
    1. macro 投稿作成者

      はじめまして。
      ご連絡ありがとうございます。
      貴重なご意見ありがとうございます。
      ご希望のマクロは今作成してあるマクロの中にはありませんが
      ご希望であればお時間頂ければ作成可能です。
      その際はこちらのサイトにアップ致します。
      よろしくお願い致します。

      返信
  3. 森 啓二

    大変有用なコード有難うございました。
    集約されたデータの最終列にファイル名とシート名が記入されますが、それぞれを転記されない方法をご教示
    頂ければと思います。
    宜しくお願いします。

    返信
    1. macro 投稿作成者

      ご連絡ありがとうございます。
      以下を削除していただければファイル名、シート名は記入されません。
      よろしくお願い致します。

      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

      返信
  4. もも

    クラウド上では、動作しないようですが、何か方法はありますか?

    返信
    1. macro 投稿作成者

      返信遅くなりました。
      クラウド上でマクロを実行は難しいようで私にはわかり兼ねます。
      お力になれず申し訳まりません。

      返信
  5. 特訓

    はじめまして。集計元のデータがA1セルからではなく例えばB10セルの場合、どこを修正すれば動くようになりますか。

    返信
    1. macro 投稿作成者

      「’列見出しをコピー」の下と「’データを1シートにまとめる」の下を「A1」からではなく「B10」に合わせて修正すれば動くと思います。
      難しければ、ファイルを開くときに「A1」からの仕様に合うように9行目まで削除とA列を削除する文を追加した方が早いかもしれません。

      返信
  6. YO

    結合したセルをコピーする場合はどうすればいいでしょうか
    また複数のセルを同時に行う場合も知りたいです

    返信
  7. V

    ‘指定したフォルダ内にあるブックのファイル取得
    sFile = Dir(SOURCE_DIR & “*.xls*”)

    上記部分でエラーになってしまいます、、。

    返信
    1. macro 投稿作成者

      返信が遅くなりまして申し訳ありません。

      私の環境では問題なく動きますのでエラーの原因はわかり兼ねます。
      お力になれず申し訳ありません。

      返信
  8. 小山 

    すいません、教えてください。
    【複数ファイルを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. macro 投稿作成者

      返信が遅くなりまして申し訳ありません。
      以下の部分を置き換えれば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

      ‘コピー元ファイルを閉じる

      返信
  9. 小山 博通

    すいません、列が非表示のファイルを再表示して取り込みたいんですが、
    上手く行かないので、ご教授お願いできますでしょうか。

    返信
    1. macro 投稿作成者

      最初のシートのみ取り込み、行列の再表示をしたい場合は以下のコードに置き換えて頂ければと思います。
      お手数お掛け致しますがよろしくお願い致します。

      ‘データを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

      ‘コピー元ファイルを閉じる

      返信

もも へ返信する コメントをキャンセル

メールアドレスが公開されることはありません。 が付いている欄は必須項目です

このサイトはスパムを低減するために Akismet を使っています。コメントデータの処理方法の詳細はこちらをご覧ください