ブック内の全シートを1シートに結合するマクロ

アクティブブックの全シートを1シートに結合するマクロを紹介します。

ただ結合するだけだと見出しや上部余白が何回も登場してしまうため、
「見出し行より下だけを結合」する仕様となっています。

この見出し行の判定は、

• 全行を選択して実行した場合は、その行を見出しとする
• それ以外の場合はフィルター設置行を見出しとする
• フィルターもない場合は1行目を見出しとする

という仕様になっていますので、お好みでカスタマイズしてください。

実行型の便利マクロですので、
Excel起動時に裏で開かれる「個人用マクロブック」などに搭載して使ってください。

ショートカットキーに登録したり、ツールバーやリボンにボタン配置すると便利です。

ソースコード

Option Explicit

' ブック内全シート結合マクロ
Sub アクティブブックの全シートを結合する()
    
    Dim 取込ブック As Workbook: Set 取込ブック = ActiveWorkbook
    
    ' 見出し行の取得（全行選択時はその行、フィルターがあればその見出し、なければ1）
    Dim 見出し行 As Long
    If Selection.Address = Selection.EntireRow.Address Then
        見出し行 = ActiveCell.Row
    ElseIf ActiveSheet.AutoFilterMode = True Then
        見出し行 = ActiveSheet.AutoFilter.Range.Row
    Else
        見出し行 = 1
    End If
    
    ' ■ ブック内シートの結合汎用関数
    Dim ws結合シート As Worksheet
    Set ws結合シート = 指定ブックの全シートを結合する(取込ブック, 見出し行)

    MsgBox "データの結合を完了しました。"
    
End Sub

' ブック内全シート結合汎用関数
Function 指定ブックの全シートを結合する(wb対象ブック As Workbook, R_見出し行 As Long _
        , Optional ByVal シート名Like条件 As String = "*") As Worksheet
        
    ' 出力するシートは第1シートをコピーして利用
    Dim ws出力シート As Worksheet
    
    ' 開いたブック内の条件合致シートをループ
    Dim ws読取シート As Worksheet
    For Each ws読取シート In wb対象ブック.Worksheets
        If ws読取シート.Name Like シート名Like条件 Then
    
            ' 最初に読み取ったシートをコピーして出力シートとして使う
            If ws出力シート Is Nothing Then
                ws読取シート.Copy
                Set ws出力シート = ActiveSheet
            
            Else
                
                ' UsedRangeのうち見出し行より下を取得
                Dim コピーエリア As Range
                Set コピーエリア = GetUsedRange指定行以下(ws読取シート, R_見出し行 + 1)
                
                ' コピーを実行
                If Not コピーエリア Is Nothing Then
                    コピーエリア.Copy ws出力シート.Cells(Get最終行(ws出力シート) + 1, コピーエリア.Column)
                End If
            
            End If
    
        End If
    Next ' 開いたブック内の条件合致シートをループ
    
    Set 指定ブックの全シートを結合する = ws出力シート

End Function

' UsedRangeから上部を切り取り
Function GetUsedRange指定行以下(対象シート As Worksheet, 指定行 As Long) As Range
    With 対象シート
        Set GetUsedRange指定行以下 = Intersect(.UsedRange, .Rows(指定行).Resize(.UsedRange.Rows.Count))
    End With
End Function

' 最終行の取得
Function Get最終行(指定シート As Worksheet) As Long
    Get最終行 = 指定シート.UsedRange.Rows.Count + 指定シート.UsedRange.Row - 1
End Function

解説

全シートをFor Each文でループして結合していくストレートなコードです。

各シートのUsedRangeのうち、見出しより下を取ってくる必要があるため、
その部分を汎用関数化して使っています。

シートの結合部分をこのマクロ専用のコードにするのはもったいないので、
「対象ブック」と「見出し行番号」を渡すと実行してくれる汎用関数にしました。

これで通常のマクロでもこの関数を使っていけますし、
今回のマクロもこの関数にActiveWorkbookを渡すだけで実装できていますね。

加えて汎用関数では、シート名条件(パターンマッチ)を指定できるようにしました。

特定の名称のシートだけを結合したい場合はこの機能を使用してください。

イミディエイトウィンドウを使えばActiveWorkbookにも簡単に実行可能です。

' イミディエイトウィンドウで「データ(○○)」シートの3行目より下を結合する
Call 指定ブックの全シートを結合する(ActiveWorkbook,3,"データ(*)")