Option Explicit
Public Sub 複数ブック統合()
    Dim twb As Workbook         '新規ブック
    Dim sheet_names As Variant  'シート名一覧
    Dim sh_name As String       'シート名
    Dim i As Long
    Dim folder As String        '参照先フォルダ名
    Dim outfolder As String     '出力先フォルダ名
    Dim count As Long           'ファイル件数
    Dim bookname As String      'マージ元ブック名
    Dim new_bookname As String  '統合ブック名
    Dim ks As Worksheet         '管理シート
    Set ks = Worksheets("管理")
    folder = ks.Range("B5").Value
    outfolder = ks.Range("B9").Value
    If folder = "" Then
        MsgBox ("参照先フォルダ名未設定")
        Exit Sub
    End If
    If outfolder = "" Then
        MsgBox ("出力先フォルダ名未設定")
        Exit Sub
    End If
    bookname = Dir(folder & "\*.xlsx")
    If bookname = "" Then
        MsgBox (folder & "内にブックが存在しません。")
        Exit Sub
    End If
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
 
    '新規ブック及びシートの作成
    'sheet_names = Array("Sheet1", "Sheet2", "シート１", "シート２")
    sheet_names = Array("Sheet1", "元データ", "元データ2")
    Set twb = Workbooks.Add
    '全てのシートを作成する
    For i = 0 To UBound(sheet_names)
        Call add_sheet(twb, sheet_names(i))
    Next
    '余分なシートを削除する
    For i = twb.Worksheets.count To 1 Step -1
        sh_name = twb.Worksheets(i).Name
        Call del_sheet(twb, sh_name, sheet_names)
    Next
    '全てのブックを処理する
    count = 0
    new_bookname = "マージ" & Left(bookname, Len(bookname) - 8) & ".xlsx"
    Do While bookname <> ""
        count = count + 1
        Call MergeBook(twb, sheet_names, count, folder, bookname)
        bookname = Dir()
    Loop
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.DisplayAlerts = False
    twb.SaveAs (outfolder & "\" & new_bookname)
    Application.DisplayAlerts = True
    twb.Close
    MsgBox ("完了")
End Sub
'新規ブックへ１シートを追加する
Private Sub add_sheet(ByVal twb As Workbook, ByVal sheet_name As String)
    Dim i As Long
    For i = 1 To twb.Worksheets.count
        If LCase(sheet_name) = LCase(twb.Worksheets(i).Name) Then
            twb.Worksheets(i).Move after:=twb.Worksheets(twb.Worksheets.count)
            Exit Sub
        End If
    Next
    twb.Worksheets.Add after:=twb.Worksheets(twb.Worksheets.count)
    twb.Worksheets(twb.Worksheets.count).Name = sheet_name
End Sub
'新規ブックから余分な１シートを削除する
Private Sub del_sheet(ByVal twb As Workbook, ByVal sheet_name As String, ByVal sheet_names As Variant)
    Dim i As Long
    For i = 0 To UBound(sheet_names)
        If LCase(sheet_name) = LCase(sheet_names(i)) Then
            Exit Sub
        End If
    Next
    Application.DisplayAlerts = False
    twb.Worksheets(sheet_name).Delete
    Application.DisplayAlerts = True
End Sub
'新規ブック１ブックをマージする
Public Sub MergeBook(ByVal twb As Workbook, ByVal sheet_names As Variant, ByVal count As Long, ByVal folder As String, ByVal bookname As String)
    Dim wb As Workbook
    Dim sh_name As String
    Dim maxrow_src As Long
    Dim maxcol_src As Long
    Dim maxrow_trg As Long
    Dim ecol As String
    Dim i As Long
    Set wb = Workbooks.Open(folder & "\" & bookname)
    For i = 0 To UBound(sheet_names)
        sh_name = sheet_names(i)
        maxrow_src = wb.Worksheets(sh_name).Cells(Rows.count, "A").End(xlUp).Row     'A列 最終行を求める
        maxcol_src = wb.Worksheets(sh_name).Cells(1, Columns.count).End(xlToLeft).Column    '1行目の最終列を求める
        maxrow_trg = twb.Worksheets(sh_name).Cells(Rows.count, "A").End(xlUp).Row    'A列 最終行を求める
        ecol = ConvertToLetter(maxcol_src)
        If count = 1 Then
            wb.Worksheets(sh_name).Range("A1:" & ecol & "3").Copy twb.Worksheets(sh_name).Range("A1")
            maxrow_trg = 3
        End If
        If maxrow_src > 3 Then
            wb.Worksheets(sh_name).Range("A4:" & ecol & maxrow_src).Copy twb.Worksheets(sh_name).Range("A" & maxrow_trg + 1)
        End If
    Next
    wb.Close
End Sub
'列番号をA～Zの文字に変換
Function ConvertToLetter(iCol As Long) As String
    Dim a As Long
    Dim b As Long
    a = iCol
    ConvertToLetter = ""
    Do While iCol > 0
        a = Int((iCol - 1) / 26)
        b = (iCol - 1) Mod 26
        ConvertToLetter = Chr(b + 65) & ConvertToLetter
        iCol = a
    Loop
End Function
 

T3B0aW9uIEV4cGxpY2l0ClB1YmxpYyBTdWIg6KSH5pWw44OW44OD44Kv57Wx5ZCIKCkKICAgIERpbSB0d2IgQXMgV29ya2Jvb2sgICAgICAgICAn5paw6KaP44OW44OD44KvCiAgICBEaW0gc2hlZXRfbmFtZXMgQXMgVmFyaWFudCAgJ+OCt+ODvOODiOWQjeS4gOimpwogICAgRGltIHNoX25hbWUgQXMgU3RyaW5nICAgICAgICfjgrfjg7zjg4jlkI0KICAgIERpbSBpIEFzIExvbmcKICAgIERpbSBmb2xkZXIgQXMgU3RyaW5nICAgICAgICAn5Y+C54Wn5YWI44OV44Kp44Or44OA5ZCNCiAgICBEaW0gb3V0Zm9sZGVyIEFzIFN0cmluZyAgICAgJ+WHuuWKm+WFiOODleOCqeODq+ODgOWQjQogICAgRGltIGNvdW50IEFzIExvbmcgICAgICAgICAgICfjg5XjgqHjgqTjg6vku7bmlbAKICAgIERpbSBib29rbmFtZSBBcyBTdHJpbmcgICAgICAn44Oe44O844K45YWD44OW44OD44Kv5ZCNCiAgICBEaW0gbmV3X2Jvb2tuYW1lIEFzIFN0cmluZyAgJ+e1seWQiOODluODg+OCr+WQjQogICAgRGltIGtzIEFzIFdvcmtzaGVldCAgICAgICAgICfnrqHnkIbjgrfjg7zjg4gKICAgIFNldCBrcyA9IFdvcmtzaGVldHMoIueuoeeQhiIpCiAgICBmb2xkZXIgPSBrcy5SYW5nZSgiQjUiKS5WYWx1ZQogICAgb3V0Zm9sZGVyID0ga3MuUmFuZ2UoIkI5IikuVmFsdWUKICAgIElmIGZvbGRlciA9ICIiIFRoZW4KICAgICAgICBNc2dCb3ggKCLlj4LnhaflhYjjg5Xjgqnjg6vjg4DlkI3mnKroqK3lrpoiKQogICAgICAgIEV4aXQgU3ViCiAgICBFbmQgSWYKICAgIElmIG91dGZvbGRlciA9ICIiIFRoZW4KICAgICAgICBNc2dCb3ggKCLlh7rlipvlhYjjg5Xjgqnjg6vjg4DlkI3mnKroqK3lrpoiKQogICAgICAgIEV4aXQgU3ViCiAgICBFbmQgSWYKICAgIGJvb2tuYW1lID0gRGlyKGZvbGRlciAmICJcKi54bHN4IikKICAgIElmIGJvb2tuYW1lID0gIiIgVGhlbgogICAgICAgIE1zZ0JveCAoZm9sZGVyICYgIuWGheOBq+ODluODg+OCr+OBjOWtmOWcqOOBl+OBvuOBm+OCk+OAgiIpCiAgICAgICAgRXhpdCBTdWIKICAgIEVuZCBJZgogICAgQXBwbGljYXRpb24uU2NyZWVuVXBkYXRpbmcgPSBGYWxzZQogICAgQXBwbGljYXRpb24uQ2FsY3VsYXRpb24gPSB4bENhbGN1bGF0aW9uTWFudWFsCiAgICAKICAgICfmlrDopo/jg5bjg4Pjgq/lj4rjgbPjgrfjg7zjg4jjga7kvZzmiJAKICAgICdzaGVldF9uYW1lcyA9IEFycmF5KCJTaGVldDEiLCAiU2hlZXQyIiwgIuOCt+ODvOODiO+8kSIsICLjgrfjg7zjg4jvvJIiKQogICAgc2hlZXRfbmFtZXMgPSBBcnJheSgiU2hlZXQxIiwgIuWFg+ODh+ODvOOCvyIsICLlhYPjg4fjg7zjgr8yIikKICAgIFNldCB0d2IgPSBXb3JrYm9va3MuQWRkCiAgICAn5YWo44Gm44Gu44K344O844OI44KS5L2c5oiQ44GZ44KLCiAgICBGb3IgaSA9IDAgVG8gVUJvdW5kKHNoZWV0X25hbWVzKQogICAgICAgIENhbGwgYWRkX3NoZWV0KHR3Yiwgc2hlZXRfbmFtZXMoaSkpCiAgICBOZXh0CiAgICAn5L2Z5YiG44Gq44K344O844OI44KS5YmK6Zmk44GZ44KLCiAgICBGb3IgaSA9IHR3Yi5Xb3Jrc2hlZXRzLmNvdW50IFRvIDEgU3RlcCAtMQogICAgICAgIHNoX25hbWUgPSB0d2IuV29ya3NoZWV0cyhpKS5OYW1lCiAgICAgICAgQ2FsbCBkZWxfc2hlZXQodHdiLCBzaF9uYW1lLCBzaGVldF9uYW1lcykKICAgIE5leHQKICAgICflhajjgabjga7jg5bjg4Pjgq/jgpLlh6bnkIbjgZnjgosKICAgIGNvdW50ID0gMAogICAgbmV3X2Jvb2tuYW1lID0gIuODnuODvOOCuCIgJiBMZWZ0KGJvb2tuYW1lLCBMZW4oYm9va25hbWUpIC0gOCkgJiAiLnhsc3giCiAgICBEbyBXaGlsZSBib29rbmFtZSA8PiAiIgogICAgICAgIGNvdW50ID0gY291bnQgKyAxCiAgICAgICAgQ2FsbCBNZXJnZUJvb2sodHdiLCBzaGVldF9uYW1lcywgY291bnQsIGZvbGRlciwgYm9va25hbWUpCiAgICAgICAgYm9va25hbWUgPSBEaXIoKQogICAgTG9vcAogICAgQXBwbGljYXRpb24uQ2FsY3VsYXRpb24gPSB4bENhbGN1bGF0aW9uQXV0b21hdGljCiAgICBBcHBsaWNhdGlvbi5TY3JlZW5VcGRhdGluZyA9IFRydWUKICAgIEFwcGxpY2F0aW9uLkRpc3BsYXlBbGVydHMgPSBGYWxzZQogICAgdHdiLlNhdmVBcyAob3V0Zm9sZGVyICYgIlwiICYgbmV3X2Jvb2tuYW1lKQogICAgQXBwbGljYXRpb24uRGlzcGxheUFsZXJ0cyA9IFRydWUKICAgIHR3Yi5DbG9zZQogICAgTXNnQm94ICgi5a6M5LqGIikKRW5kIFN1Ygon5paw6KaP44OW44OD44Kv44G477yR44K344O844OI44KS6L+95Yqg44GZ44KLClByaXZhdGUgU3ViIGFkZF9zaGVldChCeVZhbCB0d2IgQXMgV29ya2Jvb2ssIEJ5VmFsIHNoZWV0X25hbWUgQXMgU3RyaW5nKQogICAgRGltIGkgQXMgTG9uZwogICAgRm9yIGkgPSAxIFRvIHR3Yi5Xb3Jrc2hlZXRzLmNvdW50CiAgICAgICAgSWYgTENhc2Uoc2hlZXRfbmFtZSkgPSBMQ2FzZSh0d2IuV29ya3NoZWV0cyhpKS5OYW1lKSBUaGVuCiAgICAgICAgICAgIHR3Yi5Xb3Jrc2hlZXRzKGkpLk1vdmUgYWZ0ZXI6PXR3Yi5Xb3Jrc2hlZXRzKHR3Yi5Xb3Jrc2hlZXRzLmNvdW50KQogICAgICAgICAgICBFeGl0IFN1YgogICAgICAgIEVuZCBJZgogICAgTmV4dAogICAgdHdiLldvcmtzaGVldHMuQWRkIGFmdGVyOj10d2IuV29ya3NoZWV0cyh0d2IuV29ya3NoZWV0cy5jb3VudCkKICAgIHR3Yi5Xb3Jrc2hlZXRzKHR3Yi5Xb3Jrc2hlZXRzLmNvdW50KS5OYW1lID0gc2hlZXRfbmFtZQpFbmQgU3ViCifmlrDopo/jg5bjg4Pjgq/jgYvjgonkvZnliIbjgarvvJHjgrfjg7zjg4jjgpLliYrpmaTjgZnjgosKUHJpdmF0ZSBTdWIgZGVsX3NoZWV0KEJ5VmFsIHR3YiBBcyBXb3JrYm9vaywgQnlWYWwgc2hlZXRfbmFtZSBBcyBTdHJpbmcsIEJ5VmFsIHNoZWV0X25hbWVzIEFzIFZhcmlhbnQpCiAgICBEaW0gaSBBcyBMb25nCiAgICBGb3IgaSA9IDAgVG8gVUJvdW5kKHNoZWV0X25hbWVzKQogICAgICAgIElmIExDYXNlKHNoZWV0X25hbWUpID0gTENhc2Uoc2hlZXRfbmFtZXMoaSkpIFRoZW4KICAgICAgICAgICAgRXhpdCBTdWIKICAgICAgICBFbmQgSWYKICAgIE5leHQKICAgIEFwcGxpY2F0aW9uLkRpc3BsYXlBbGVydHMgPSBGYWxzZQogICAgdHdiLldvcmtzaGVldHMoc2hlZXRfbmFtZSkuRGVsZXRlCiAgICBBcHBsaWNhdGlvbi5EaXNwbGF5QWxlcnRzID0gVHJ1ZQpFbmQgU3ViCifmlrDopo/jg5bjg4Pjgq/vvJHjg5bjg4Pjgq/jgpLjg57jg7zjgrjjgZnjgosKUHVibGljIFN1YiBNZXJnZUJvb2soQnlWYWwgdHdiIEFzIFdvcmtib29rLCBCeVZhbCBzaGVldF9uYW1lcyBBcyBWYXJpYW50LCBCeVZhbCBjb3VudCBBcyBMb25nLCBCeVZhbCBmb2xkZXIgQXMgU3RyaW5nLCBCeVZhbCBib29rbmFtZSBBcyBTdHJpbmcpCiAgICBEaW0gd2IgQXMgV29ya2Jvb2sKICAgIERpbSBzaF9uYW1lIEFzIFN0cmluZwogICAgRGltIG1heHJvd19zcmMgQXMgTG9uZwogICAgRGltIG1heGNvbF9zcmMgQXMgTG9uZwogICAgRGltIG1heHJvd190cmcgQXMgTG9uZwogICAgRGltIGVjb2wgQXMgU3RyaW5nCiAgICBEaW0gaSBBcyBMb25nCiAgICBTZXQgd2IgPSBXb3JrYm9va3MuT3Blbihmb2xkZXIgJiAiXCIgJiBib29rbmFtZSkKICAgIEZvciBpID0gMCBUbyBVQm91bmQoc2hlZXRfbmFtZXMpCiAgICAgICAgc2hfbmFtZSA9IHNoZWV0X25hbWVzKGkpCiAgICAgICAgbWF4cm93X3NyYyA9IHdiLldvcmtzaGVldHMoc2hfbmFtZSkuQ2VsbHMoUm93cy5jb3VudCwgIkEiKS5FbmQoeGxVcCkuUm93ICAgICAnQeWIlyDmnIDntYLooYzjgpLmsYLjgoHjgosKICAgICAgICBtYXhjb2xfc3JjID0gd2IuV29ya3NoZWV0cyhzaF9uYW1lKS5DZWxscygxLCBDb2x1bW5zLmNvdW50KS5FbmQoeGxUb0xlZnQpLkNvbHVtbiAgICAnMeihjOebruOBruacgOe1guWIl+OCkuaxguOCgeOCiwogICAgICAgIG1heHJvd190cmcgPSB0d2IuV29ya3NoZWV0cyhzaF9uYW1lKS5DZWxscyhSb3dzLmNvdW50LCAiQSIpLkVuZCh4bFVwKS5Sb3cgICAgJ0HliJcg5pyA57WC6KGM44KS5rGC44KB44KLCiAgICAgICAgZWNvbCA9IENvbnZlcnRUb0xldHRlcihtYXhjb2xfc3JjKQogICAgICAgIElmIGNvdW50ID0gMSBUaGVuCiAgICAgICAgICAgIHdiLldvcmtzaGVldHMoc2hfbmFtZSkuUmFuZ2UoIkExOiIgJiBlY29sICYgIjMiKS5Db3B5IHR3Yi5Xb3Jrc2hlZXRzKHNoX25hbWUpLlJhbmdlKCJBMSIpCiAgICAgICAgICAgIG1heHJvd190cmcgPSAzCiAgICAgICAgRW5kIElmCiAgICAgICAgSWYgbWF4cm93X3NyYyA+IDMgVGhlbgogICAgICAgICAgICB3Yi5Xb3Jrc2hlZXRzKHNoX25hbWUpLlJhbmdlKCJBNDoiICYgZWNvbCAmIG1heHJvd19zcmMpLkNvcHkgdHdiLldvcmtzaGVldHMoc2hfbmFtZSkuUmFuZ2UoIkEiICYgbWF4cm93X3RyZyArIDEpCiAgICAgICAgRW5kIElmCiAgICBOZXh0CiAgICB3Yi5DbG9zZQpFbmQgU3ViCifliJfnlarlj7fjgpJB772eWuOBruaWh+Wtl+OBq+WkieaPmwpGdW5jdGlvbiBDb252ZXJ0VG9MZXR0ZXIoaUNvbCBBcyBMb25nKSBBcyBTdHJpbmcKICAgIERpbSBhIEFzIExvbmcKICAgIERpbSBiIEFzIExvbmcKICAgIGEgPSBpQ29sCiAgICBDb252ZXJ0VG9MZXR0ZXIgPSAiIgogICAgRG8gV2hpbGUgaUNvbCA+IDAKICAgICAgICBhID0gSW50KChpQ29sIC0gMSkgLyAyNikKICAgICAgICBiID0gKGlDb2wgLSAxKSBNb2QgMjYKICAgICAgICBDb252ZXJ0VG9MZXR0ZXIgPSBDaHIoYiArIDY1KSAmIENvbnZlcnRUb0xldHRlcgogICAgICAgIGlDb2wgPSBhCiAgICBMb29wCkVuZCBGdW5jdGlvbgo=