Option Explicit
 
Sub 別ブックのすべてのセルを取得5()
 
    Dim startTime As Double
    Dim middleTime As Double
    Dim processTime As Double
 
    startTime = Timer    '開始時間取得
 
    Application.ScreenUpdating = False                                                               '画面描画を停止
    Application.EnableEvents = False                                                                 'イベントを抑止
    Application.DisplayAlerts = False                                                                '確認メッセージを抑止
    Application.Calculation = xlCalculationManual                                                    '計算を手動に
 
    '------------------------------------------------------------------------ここまで
    '↑ここまでは上記サンプルコードと同一↑
    'メイン処理0の時間をイミディエイトウィンドウに出力
    middleTime = Timer
    processTime = middleTime - startTime
    Debug.Print "メイン処理0の終了："; processTime & "秒" & vbCrLf
    'Call メイン処理0の終了
 
    '------------------------------------------------------------------------1ここから
    Dim FullPath1 As String, FullPath2 As String, FullPath3 As String, FullPath4 As String
    FullPath1 = "C:\Users\名前\Desktop\Excelフォルダ" & "\" & "配信スケジュール .xlsm"                    ' "救急患者集計.xlsm"
    FullPath2 = "C:\Users\名前\Desktop\Excelフォルダ" & "\" & "未納本文.xlsm"                    ' "救急患者集計.xlsm""未納整理簿.xlsm"
    FullPath3 = "C:\Users\名前\Desktop\Excelフォルダ" & "\" & "未納本文.xlsm"                     ' "救急患者集計.xlsm""未納整理簿.xlsm"
    FullPath4 = "C:\Users\名前\Desktop\Excelフォルダ" & "\" & "未納本文.xlsm"                    ' "救急患者集計.xlsm""未収金折衝状況表.xlsm"
 
    FullPath1 = "D:\goo\excel\goo446\配信スケジュール.xlsm"
    FullPath2 = "D:\goo\excel\goo446\未納本文.xlsm"
    FullPath3 = "D:\goo\excel\goo446\未納本文.xlsm"
    FullPath4 = "D:\goo\excel\goo446\未納本文.xlsm"
 
    Dim Fullpath As Variant
    Dim Frsheet As Variant
    Dim ToSheet As Variant
    Dim Title As Variant
    Dim i As Long
    Fullpath = Array(FullPath1, FullPath2, FullPath3, FullPath4)
    Frsheet = Array("sheet5", "未納本文", "全部1", "未納本文")
    ToSheet = Array("kyu", "nyu", "gai", "折衝取込")
    Title = Array("未納本文処理1の終了：", "全部1処理2の終了：", "未納本文処理3の終了：", "全部1をふくめた完了までの所要時間：")
    '既存のシート削除
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        If check_sheet(ws.name, ToSheet) = True Then
            ws.Delete
        End If
    Next
    'シートのコピー
    For i = 3 To 0 Step -1
        Call copy_sheet(Fullpath(i), Frsheet(i), ToSheet(i))
        middleTime = Timer
        processTime = middleTime - startTime
        Debug.Print Title(i); processTime & "秒" & vbCrLf
    Next
 
    Application.Calculation = xlCalculationAutomatic                                                          '計算を自動に
    Application.DisplayAlerts = True                                                                          '確認メッセージを開始
    Application.EnableEvents = True                                                                           'イベントを開始
    Application.ScreenUpdating = True
    MsgBox "書き換えました"
End Sub
Private Function check_sheet(ByVal name As String, ByVal ToSheet As Variant) As Boolean
    Dim i As Long
    check_sheet = True
    For i = 0 To UBound(ToSheet)
        If name = ToSheet(i) Then Exit Function
    Next
    check_sheet = False
End Function
 
Private Sub copy_sheet(ByVal Fullpath As String, ByVal Frsheet As String, ByVal ToSheet As String)
    Dim Fwb As Workbook
    Set Fwb = Workbooks.Open(Fullpath, ReadOnly:=True)   '読取り専用で開く
    ActiveWindow.Visible = False
    Fwb.Worksheets(Frsheet).Copy Before:=ThisWorkbook.Worksheets(1)
    ThisWorkbook.Worksheets(1).name = ToSheet
    Fwb.Close
End Sub
 
 

T3B0aW9uIEV4cGxpY2l0CgpTdWIg5Yil44OW44OD44Kv44Gu44GZ44G544Gm44Gu44K744Or44KS5Y+W5b6XNSgpCgogICAgRGltIHN0YXJ0VGltZSBBcyBEb3VibGUKICAgIERpbSBtaWRkbGVUaW1lIEFzIERvdWJsZQogICAgRGltIHByb2Nlc3NUaW1lIEFzIERvdWJsZQoKICAgIHN0YXJ0VGltZSA9IFRpbWVyICAgICfplovlp4vmmYLplpPlj5blvpcKCiAgICBBcHBsaWNhdGlvbi5TY3JlZW5VcGRhdGluZyA9IEZhbHNlICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgJ+eUu+mdouaPj+eUu+OCkuWBnOatogogICAgQXBwbGljYXRpb24uRW5hYmxlRXZlbnRzID0gRmFsc2UgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICfjgqTjg5njg7Pjg4jjgpLmipHmraIKICAgIEFwcGxpY2F0aW9uLkRpc3BsYXlBbGVydHMgPSBGYWxzZSAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAn56K66KqN44Oh44OD44K744O844K444KS5oqR5q2iCiAgICBBcHBsaWNhdGlvbi5DYWxjdWxhdGlvbiA9IHhsQ2FsY3VsYXRpb25NYW51YWwgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgJ+ioiOeul+OCkuaJi+WLleOBqwoKICAgICctLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS3jgZPjgZPjgb7jgacKICAgICfihpHjgZPjgZPjgb7jgafjga/kuIroqJjjgrXjg7Pjg5fjg6vjgrPjg7zjg4njgajlkIzkuIDihpEKICAgICfjg6HjgqTjg7Plh6bnkIYw44Gu5pmC6ZaT44KS44Kk44Of44OH44Kj44Ko44Kk44OI44Km44Kj44Oz44OJ44Km44Gr5Ye65YqbCiAgICBtaWRkbGVUaW1lID0gVGltZXIKICAgIHByb2Nlc3NUaW1lID0gbWlkZGxlVGltZSAtIHN0YXJ0VGltZQogICAgRGVidWcuUHJpbnQgIuODoeOCpOODs+WHpueQhjDjga7ntYLkuobvvJoiOyBwcm9jZXNzVGltZSAmICLnp5IiICYgdmJDckxmCiAgICAnQ2FsbCDjg6HjgqTjg7Plh6bnkIYw44Gu57WC5LqGCgogICAgJy0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLTHjgZPjgZPjgYvjgokKICAgIERpbSBGdWxsUGF0aDEgQXMgU3RyaW5nLCBGdWxsUGF0aDIgQXMgU3RyaW5nLCBGdWxsUGF0aDMgQXMgU3RyaW5nLCBGdWxsUGF0aDQgQXMgU3RyaW5nCiAgICBGdWxsUGF0aDEgPSAiQzpcVXNlcnNc5ZCN5YmNXERlc2t0b3BcRXhjZWzjg5Xjgqnjg6vjg4AiICYgIlwiICYgIumFjeS/oeOCueOCseOCuOODpeODvOODqyAueGxzbSIgICAgICAgICAgICAgICAgICAgICcgIuaVkeaApeaCo+iAhembhuioiC54bHNtIgogICAgRnVsbFBhdGgyID0gIkM6XFVzZXJzXOWQjeWJjVxEZXNrdG9wXEV4Y2Vs44OV44Kp44Or44OAIiAmICJcIiAmICLmnKrntI3mnKzmlocueGxzbSIgICAgICAgICAgICAgICAgICAgICcgIuaVkeaApeaCo+iAhembhuioiC54bHNtIiLmnKrntI3mlbTnkIbnsL8ueGxzbSIKICAgIEZ1bGxQYXRoMyA9ICJDOlxVc2Vyc1zlkI3liY1cRGVza3RvcFxFeGNlbOODleOCqeODq+ODgCIgJiAiXCIgJiAi5pyq57SN5pys5paHLnhsc20iICAgICAgICAgICAgICAgICAgICAgJyAi5pWR5oCl5oKj6ICF6ZuG6KiILnhsc20iIuacque0jeaVtOeQhuewvy54bHNtIgogICAgRnVsbFBhdGg0ID0gIkM6XFVzZXJzXOWQjeWJjVxEZXNrdG9wXEV4Y2Vs44OV44Kp44Or44OAIiAmICJcIiAmICLmnKrntI3mnKzmlocueGxzbSIgICAgICAgICAgICAgICAgICAgICcgIuaVkeaApeaCo+iAhembhuioiC54bHNtIiLmnKrlj47ph5HmipjooZ3nirbms4HooagueGxzbSIKCiAgICBGdWxsUGF0aDEgPSAiRDpcZ29vXGV4Y2VsXGdvbzQ0NlzphY3kv6HjgrnjgrHjgrjjg6Xjg7zjg6sueGxzbSIKICAgIEZ1bGxQYXRoMiA9ICJEOlxnb29cZXhjZWxcZ29vNDQ2XOacque0jeacrOaWhy54bHNtIgogICAgRnVsbFBhdGgzID0gIkQ6XGdvb1xleGNlbFxnb280NDZc5pyq57SN5pys5paHLnhsc20iCiAgICBGdWxsUGF0aDQgPSAiRDpcZ29vXGV4Y2VsXGdvbzQ0NlzmnKrntI3mnKzmlocueGxzbSIKCiAgICBEaW0gRnVsbHBhdGggQXMgVmFyaWFudAogICAgRGltIEZyc2hlZXQgQXMgVmFyaWFudAogICAgRGltIFRvU2hlZXQgQXMgVmFyaWFudAogICAgRGltIFRpdGxlIEFzIFZhcmlhbnQKICAgIERpbSBpIEFzIExvbmcKICAgIEZ1bGxwYXRoID0gQXJyYXkoRnVsbFBhdGgxLCBGdWxsUGF0aDIsIEZ1bGxQYXRoMywgRnVsbFBhdGg0KQogICAgRnJzaGVldCA9IEFycmF5KCJzaGVldDUiLCAi5pyq57SN5pys5paHIiwgIuWFqOmDqDEiLCAi5pyq57SN5pys5paHIikKICAgIFRvU2hlZXQgPSBBcnJheSgia3l1IiwgIm55dSIsICJnYWkiLCAi5oqY6KGd5Y+W6L68IikKICAgIFRpdGxlID0gQXJyYXkoIuacque0jeacrOaWh+WHpueQhjHjga7ntYLkuobvvJoiLCAi5YWo6YOoMeWHpueQhjLjga7ntYLkuobvvJoiLCAi5pyq57SN5pys5paH5Yem55CGM+OBrue1guS6hu+8miIsICLlhajpg6gx44KS44G144GP44KB44Gf5a6M5LqG44G+44Gn44Gu5omA6KaB5pmC6ZaT77yaIikKICAgICfml6LlrZjjga7jgrfjg7zjg4jliYrpmaQKICAgIERpbSB3cyBBcyBXb3Jrc2hlZXQKICAgIEZvciBFYWNoIHdzIEluIFRoaXNXb3JrYm9vay5Xb3Jrc2hlZXRzCiAgICAgICAgSWYgY2hlY2tfc2hlZXQod3MubmFtZSwgVG9TaGVldCkgPSBUcnVlIFRoZW4KICAgICAgICAgICAgd3MuRGVsZXRlCiAgICAgICAgRW5kIElmCiAgICBOZXh0CiAgICAn44K344O844OI44Gu44Kz44OU44O8CiAgICBGb3IgaSA9IDMgVG8gMCBTdGVwIC0xCiAgICAgICAgQ2FsbCBjb3B5X3NoZWV0KEZ1bGxwYXRoKGkpLCBGcnNoZWV0KGkpLCBUb1NoZWV0KGkpKQogICAgICAgIG1pZGRsZVRpbWUgPSBUaW1lcgogICAgICAgIHByb2Nlc3NUaW1lID0gbWlkZGxlVGltZSAtIHN0YXJ0VGltZQogICAgICAgIERlYnVnLlByaW50IFRpdGxlKGkpOyBwcm9jZXNzVGltZSAmICLnp5IiICYgdmJDckxmCiAgICBOZXh0CiAgICAKICAgIEFwcGxpY2F0aW9uLkNhbGN1bGF0aW9uID0geGxDYWxjdWxhdGlvbkF1dG9tYXRpYyAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAn6KiI566X44KS6Ieq5YuV44GrCiAgICBBcHBsaWNhdGlvbi5EaXNwbGF5QWxlcnRzID0gVHJ1ZSAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgJ+eiuuiqjeODoeODg+OCu+ODvOOCuOOCkumWi+WniwogICAgQXBwbGljYXRpb24uRW5hYmxlRXZlbnRzID0gVHJ1ZSAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICfjgqTjg5njg7Pjg4jjgpLplovlp4sKICAgIEFwcGxpY2F0aW9uLlNjcmVlblVwZGF0aW5nID0gVHJ1ZQogICAgTXNnQm94ICLmm7jjgY3mj5vjgYjjgb7jgZfjgZ8iCkVuZCBTdWIKUHJpdmF0ZSBGdW5jdGlvbiBjaGVja19zaGVldChCeVZhbCBuYW1lIEFzIFN0cmluZywgQnlWYWwgVG9TaGVldCBBcyBWYXJpYW50KSBBcyBCb29sZWFuCiAgICBEaW0gaSBBcyBMb25nCiAgICBjaGVja19zaGVldCA9IFRydWUKICAgIEZvciBpID0gMCBUbyBVQm91bmQoVG9TaGVldCkKICAgICAgICBJZiBuYW1lID0gVG9TaGVldChpKSBUaGVuIEV4aXQgRnVuY3Rpb24KICAgIE5leHQKICAgIGNoZWNrX3NoZWV0ID0gRmFsc2UKRW5kIEZ1bmN0aW9uCgpQcml2YXRlIFN1YiBjb3B5X3NoZWV0KEJ5VmFsIEZ1bGxwYXRoIEFzIFN0cmluZywgQnlWYWwgRnJzaGVldCBBcyBTdHJpbmcsIEJ5VmFsIFRvU2hlZXQgQXMgU3RyaW5nKQogICAgRGltIEZ3YiBBcyBXb3JrYm9vawogICAgU2V0IEZ3YiA9IFdvcmtib29rcy5PcGVuKEZ1bGxwYXRoLCBSZWFkT25seTo9VHJ1ZSkgICAn6Kqt5Y+W44KK5bCC55So44Gn6ZaL44GPCiAgICBBY3RpdmVXaW5kb3cuVmlzaWJsZSA9IEZhbHNlCiAgICBGd2IuV29ya3NoZWV0cyhGcnNoZWV0KS5Db3B5IEJlZm9yZTo9VGhpc1dvcmtib29rLldvcmtzaGVldHMoMSkKICAgIFRoaXNXb3JrYm9vay5Xb3Jrc2hlZXRzKDEpLm5hbWUgPSBUb1NoZWV0CiAgICBGd2IuQ2xvc2UKRW5kIFN1YgoK