Sub 3＿ファイル結合()

    '選択可能ファイルのフィルターを設定
    Const C_FILEFILTER As String = "Excelファイル,*.xlsx;*.xls"

    '開いているブック数が2つ以上の場合は終了
    If 1 < Workbooks.Count Then
        MsgBox "このブック以外のExcelファイルを閉じてください", _
               vbExclamation, _
               "終了します"
        Exit Sub
    End If

    'ファイルの選択
    Dim varFilesName As Variant
    varFilesName = Application.GetOpenFilename(C_FILEFILTER, , _
                                               "ファイルを複数選択してください", , _
                                               True)
    
    'キャンセルを選択した場合は終了
    If VarType(varFilesName) = vbBoolean Then Exit Sub

    '選択したファイルが1つの場合は抜ける
    If UBound(varFilesName) = 0 Then
        MsgBox "複数のファイルを選択してください", _
               vbExclamation, _
               "終了します"
        Exit Sub
    End If

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False

    '統合用新規ブックを作成
    Dim NWB As Workbook
    Set NWB = Workbooks.Add

    On Error Resume Next

    Dim varName       As Variant
    Dim AWB           As Workbook
    Dim CWB           As Workbook
    Dim Sh            As Worksheet
    Dim strErrFiles() As String
    Dim lngErrCount   As Long
    Dim lngCount      As Long

    For Each varName In varFilesName
        '選択ファイルとマクロ実行ファイルが同じ場合は処理を行わない
        If varName = ThisWorkbook.FullName Then
            'マクロ実行ファイル統合処理の対象外
        Else
            '選択したファイルを開く
            Set AWB = Workbooks.Open(varName)

            For Each Sh In AWB.Worksheets
                '対象シートをコピーする(新規ブックとしてコピーされる)
                Sh.Copy
                Set CWB = ActiveWorkbook
                '統合用新規ブックにコピーしたシートを移動する
                CWB.Worksheets(1).Move After:=NWB.Worksheets(NWB.Worksheets.Count)
            Next

            '開いたファイルを閉じる
            AWB.Close False

            'エラー確認
            If Err.Number = 0 Then
                lngCount = lngCount + 1
            Else
                Err.Clear
                ReDim Preserve strErrFiles(lngErrCount)
                strErrFiles(lngErrCount) = varName
                lngErrCount = lngErrCount + 1
            End If
        End If
    Next
    
    '統合ブックの1枚目のシートを削除
    If 1 < NWB.Worksheets.Count Then NWB.Worksheets(1).Delete

    On Error GoTo 0

    Application.EnableEvents = True
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    '終了メッセージ
    If lngErrCount = 0 Then
        MsgBox "新規ブックに" & lngCount & "つのブックを統合しました", _
               vbInformation, _
               "終了しました"
    Else
        MsgBox "エラーになったファイルがあります" & vbLf & vbLf & Join$(strErrFiles, vbLf), _
               vbExclamation, _
               "終了しました"
    End If
End Sub