【Excel マクロ無料配布中！】複数シートを1枚にまとめ、シート名を追記するマクロを紹介＆配布！

2022年10月17日 22:26

複数シートのコピペは地味に時間がかかる。そして人為的なミスも発生しやすい。

データが月別や部署別になっておりマージしなければならない！なんてこと、ビジネスシーンでは多々起きると思います！
これが20シート、30シートとなれば、1シートずつ開いてコピペするのは気の遠くなる作業です。
こんな時マクロであれば一瞬で解決できます！
ご紹介するコードをコピペでもできますし、マクロファイルも添付しますので皆様の状況に合わせてコード修正しご活用ください。（ご使用は自己責任でお願い致します。）

前提の状況についてご説明

今回、列項目が同じシート10枚を『summary』シートに取りまとめ致します。各シートよくありそうな状況に合わせて「JAN」、「売上金額」、「売上数量」の3列の同一項目と設定しております。（こちら活用いただく際は列名ご自由に変更ください。）行数は各シートバラバラとなります。

複数シートを1枚にまとめ、シート名を追記するエクセルマクロコードをご紹介

早速ですが下記コードで実行可能です。解説はコメントにて記載しておりますのでご確認ください。こちらのコードを活用いただき、シートが3列以上ある場合も使用可能です。

Sub Sheet_Marge()

Dim summary_Sheet As Worksheet
Dim Ws As Worksheet
Dim LR1 As Long
Dim LR2 As Long
Set summary_Sheet = Sheets("summary")
    
    '1行目が表頭なので2行目から貼り付けするため2としております。
    LR2 = 2

    Application.ScreenUpdating = False

    'シートループ
    For Each Ws In Worksheets

        '「summary」シートじゃなければ実行するという条件
        If Ws.Name <> summary_Sheet.Name Then
            'summary_sheetでまとめる。
            With summary_Sheet

                '任意のシートの最終行を取得
                LR1 = Ws.Cells(Rows.Count, 1).End(xlUp).Row

                'A2からCの末行までのデータをコピーして「summary」シートのAの空欄へ貼り付け
　　　　　　　　　'列が3列より増える場合、下記コードの3を変更しコピー範囲を調整ください！
                Ws.Select
                Ws.Range(Ws.Cells(2, 1), Cells(LR1, 3)).Copy .Cells(LR2, 1)

                'D列にシート名を追加(シート名を別列に入れる場合は下記コードの4を変更ください！)
                summary_Sheet.Select
                summary_Sheet.Range(.Cells(LR2, 4), _
                    Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 4)) = Ws.Name

                 '「summary」シートの最終行取得
                LR2 = .Cells(Rows.Count, 1).End(xlUp).Row + 1

            End With
        End If
    Next

    Application.ScreenUpdating = True

End Sub

複数シートを1枚にまとめ、シート名を追記するエクセルマクロを配布！

下記に添付しますので活用してみてください！是非活用する方はスキ・コメントをお願い致します。今後の活動の励みになります！！

まとめ

今回ビジネスシーンでよく使う複数シートをマージするというマクロをご紹介しました。今後も皆様が日頃の業務で活用しやすいマクロを共有しようと思いますので是非チェックしてみてください。

ついでといっては何ですが、インスタにて小技等も公開しておりますので、是非ご確認ください。
https://www.instagram.com/maro.consulting/

この記事が気に入ったらサポートをしてみませんか？