Option Explicit
 
Sub 別ブックのすべてのセルを取得3()
 
    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                                                    '計算を手動に
 
    Dim Excel As New Application
 
    'エクセルを不可視で開く
    Excel.Visible = False    'エクセル可視/不可視設定
    Excel.DisplayAlerts = False      '警告メッセージをオフ
 
    '------------------------------------------------------------------------ここまで
    '↑ここまでは上記サンプルコードと同一↑
    'メイン処理0の時間をイミディエイトウィンドウに出力
    middleTime = Timer
    processTime = middleTime - startTime
    Debug.Print "メイン処理0の終了："; processTime & "秒" & vbCrLf
    'Call メイン処理0の終了
 
    Dim ws As Worksheet
    Dim filename As String
    Dim mb As Workbook
 
    '貼り付け先のブック
    filename = ThisWorkbook.path & "\" & "ワークシート.xlsm"
    Set mb = Workbooks.Open(filename)
 
    '------------------------------------------------------------------------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をふくめた完了までの所要時間：")
    For i = 0 To 3
        Call copy_sheet(Fullpath(i), Frsheet(i), mb, 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
 
 
    Excel.DisplayAlerts = True      '警告メッセージをオン
    Excel.Quit      'Excel終了
 
    Set Excel = Nothing      '参照を解放
    MsgBox "書き換えました"
End Sub
 
Private Sub copy_sheet(ByVal Fullpath As String, ByVal Frsheet As String, ByRef mb As Workbook, ByVal Tosheet As String)
    Dim Fwb As Workbook
    Dim SourceRng As Range
    Dim TargetRng As Range
    Set Fwb = Workbooks.Open(Fullpath, ReadOnly:=True)   '読取り専用で開く
    ActiveWindow.Visible = False
    Set SourceRng = Fwb.Worksheets(Frsheet).UsedRange
    mb.Worksheets(Tosheet).Cells.Clear
    Set TargetRng = mb.Worksheets(Tosheet).Range("A1")
    SourceRng.Copy
    TargetRng.PasteSpecial Paste:=xlPasteFormulasAndNumberFormats
    TargetRng.PasteSpecial Paste:=xlPasteColumnWidths
    Application.CutCopyMode = False
    Fwb.Close
End Sub
Private Sub copy_sheet2(ByVal Fullpath As String, ByVal Frsheet As String, ByRef mb As Workbook, ByVal Tosheet As String)
    Dim Fwb As Workbook
    Dim SourceRng As Range
    Dim TargetRng As Range
    Set Fwb = Workbooks.Open(Fullpath, ReadOnly:=True)   '読取り専用で開く
    ActiveWindow.Visible = False
    Set SourceRng = Fwb.Worksheets(Frsheet).UsedRange
    mb.Worksheets(Tosheet).Cells.Clear
    Set TargetRng = mb.Worksheets(Tosheet).Range("A1")
    SourceRng.Copy Destination:=TargetRng
    Fwb.Close
End Sub
 
 

T3B0aW9uIEV4cGxpY2l0CgpTdWIg5Yil44OW44OD44Kv44Gu44GZ44G544Gm44Gu44K744Or44KS5Y+W5b6XMygpCgogICAgRGltIHN0YXJ0VGltZSBBcyBEb3VibGUKICAgIERpbSBtaWRkbGVUaW1lIEFzIERvdWJsZQogICAgRGltIHByb2Nlc3NUaW1lIEFzIERvdWJsZQoKICAgIHN0YXJ0VGltZSA9IFRpbWVyICAgICfplovlp4vmmYLplpPlj5blvpcKCiAgICBBcHBsaWNhdGlvbi5TY3JlZW5VcGRhdGluZyA9IEZhbHNlICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgJ+eUu+mdouaPj+eUu+OCkuWBnOatogogICAgQXBwbGljYXRpb24uRW5hYmxlRXZlbnRzID0gRmFsc2UgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICfjgqTjg5njg7Pjg4jjgpLmipHmraIKICAgIEFwcGxpY2F0aW9uLkRpc3BsYXlBbGVydHMgPSBGYWxzZSAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAn56K66KqN44Oh44OD44K744O844K444KS5oqR5q2iCiAgICBBcHBsaWNhdGlvbi5DYWxjdWxhdGlvbiA9IHhsQ2FsY3VsYXRpb25NYW51YWwgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgJ+ioiOeul+OCkuaJi+WLleOBqwoKICAgIERpbSBFeGNlbCBBcyBOZXcgQXBwbGljYXRpb24KCiAgICAn44Ko44Kv44K744Or44KS5LiN5Y+v6KaW44Gn6ZaL44GPCiAgICBFeGNlbC5WaXNpYmxlID0gRmFsc2UgICAgJ+OCqOOCr+OCu+ODq+WPr+imli/kuI3lj6/oppboqK3lrpoKICAgIEV4Y2VsLkRpc3BsYXlBbGVydHMgPSBGYWxzZSAgICAgICforablkYrjg6Hjg4Pjgrvjg7zjgrjjgpLjgqrjg5UKCiAgICAnLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0t44GT44GT44G+44GnCiAgICAn4oaR44GT44GT44G+44Gn44Gv5LiK6KiY44K144Oz44OX44Or44Kz44O844OJ44Go5ZCM5LiA4oaRCiAgICAn44Oh44Kk44Oz5Yem55CGMOOBruaZgumWk+OCkuOCpOODn+ODh+OCo+OCqOOCpOODiOOCpuOCo+ODs+ODieOCpuOBq+WHuuWKmwogICAgbWlkZGxlVGltZSA9IFRpbWVyCiAgICBwcm9jZXNzVGltZSA9IG1pZGRsZVRpbWUgLSBzdGFydFRpbWUKICAgIERlYnVnLlByaW50ICLjg6HjgqTjg7Plh6bnkIYw44Gu57WC5LqG77yaIjsgcHJvY2Vzc1RpbWUgJiAi56eSIiAmIHZiQ3JMZgogICAgJ0NhbGwg44Oh44Kk44Oz5Yem55CGMOOBrue1guS6hgoKICAgIERpbSB3cyBBcyBXb3Jrc2hlZXQKICAgIERpbSBmaWxlbmFtZSBBcyBTdHJpbmcKICAgIERpbSBtYiBBcyBXb3JrYm9vawoKICAgICfosrzjgorku5jjgZHlhYjjga7jg5bjg4Pjgq8KICAgIGZpbGVuYW1lID0gVGhpc1dvcmtib29rLnBhdGggJiAiXCIgJiAi44Ov44O844Kv44K344O844OILnhsc20iCiAgICBTZXQgbWIgPSBXb3JrYm9va3MuT3BlbihmaWxlbmFtZSkKICAgIAogICAgJy0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLTHjgZPjgZPjgYvjgokKICAgIERpbSBGdWxsUGF0aDEgQXMgU3RyaW5nLCBGdWxsUGF0aDIgQXMgU3RyaW5nLCBGdWxsUGF0aDMgQXMgU3RyaW5nLCBGdWxsUGF0aDQgQXMgU3RyaW5nCiAgICBGdWxsUGF0aDEgPSAiQzpcVXNlcnNc5ZCN5YmNXERlc2t0b3BcRXhjZWzjg5Xjgqnjg6vjg4AiICYgIlwiICYgIumFjeS/oeOCueOCseOCuOODpeODvOODqyAueGxzbSIgICAgICAgICAgICAgICAgICAgICcgIuaVkeaApeaCo+iAhembhuioiC54bHNtIgogICAgRnVsbFBhdGgyID0gIkM6XFVzZXJzXOWQjeWJjVxEZXNrdG9wXEV4Y2Vs44OV44Kp44Or44OAIiAmICJcIiAmICLmnKrntI3mnKzmlocueGxzbSIgICAgICAgICAgICAgICAgICAgICcgIuaVkeaApeaCo+iAhembhuioiC54bHNtIiLmnKrntI3mlbTnkIbnsL8ueGxzbSIKICAgIEZ1bGxQYXRoMyA9ICJDOlxVc2Vyc1zlkI3liY1cRGVza3RvcFxFeGNlbOODleOCqeODq+ODgCIgJiAiXCIgJiAi5pyq57SN5pys5paHLnhsc20iICAgICAgICAgICAgICAgICAgICAgJyAi5pWR5oCl5oKj6ICF6ZuG6KiILnhsc20iIuacque0jeaVtOeQhuewvy54bHNtIgogICAgRnVsbFBhdGg0ID0gIkM6XFVzZXJzXOWQjeWJjVxEZXNrdG9wXEV4Y2Vs44OV44Kp44Or44OAIiAmICJcIiAmICLmnKrntI3mnKzmlocueGxzbSIgICAgICAgICAgICAgICAgICAgICcgIuaVkeaApeaCo+iAhembhuioiC54bHNtIiLmnKrlj47ph5HmipjooZ3nirbms4HooagueGxzbSIKCiAgICBGdWxsUGF0aDEgPSAiRDpcZ29vXGV4Y2VsXGdvbzQ0NlzphY3kv6HjgrnjgrHjgrjjg6Xjg7zjg6sueGxzbSIKICAgIEZ1bGxQYXRoMiA9ICJEOlxnb29cZXhjZWxcZ29vNDQ2XOacque0jeacrOaWhy54bHNtIgogICAgRnVsbFBhdGgzID0gIkQ6XGdvb1xleGNlbFxnb280NDZc5pyq57SN5pys5paHLnhsc20iCiAgICBGdWxsUGF0aDQgPSAiRDpcZ29vXGV4Y2VsXGdvbzQ0NlzmnKrntI3mnKzmlocueGxzbSIKCiAgICBEaW0gRnVsbHBhdGggQXMgVmFyaWFudAogICAgRGltIEZyc2hlZXQgQXMgVmFyaWFudAogICAgRGltIFRvc2hlZXQgQXMgVmFyaWFudAogICAgRGltIFRpdGxlIEFzIFZhcmlhbnQKICAgIERpbSBpIEFzIExvbmcKICAgIEZ1bGxwYXRoID0gQXJyYXkoRnVsbFBhdGgxLCBGdWxsUGF0aDIsIEZ1bGxQYXRoMywgRnVsbFBhdGg0KQogICAgRnJzaGVldCA9IEFycmF5KCJzaGVldDUiLCAi5pyq57SN5pys5paHIiwgIuWFqOmDqDEiLCAi5pyq57SN5pys5paHIikKICAgIFRvc2hlZXQgPSBBcnJheSgia3l1IiwgIm55dSIsICJnYWkiLCAi5oqY6KGd5Y+W6L68IikKICAgIFRpdGxlID0gQXJyYXkoIuacque0jeacrOaWh+WHpueQhjHjga7ntYLkuobvvJoiLCAi5YWo6YOoMeWHpueQhjLjga7ntYLkuobvvJoiLCAi5pyq57SN5pys5paH5Yem55CGM+OBrue1guS6hu+8miIsICLlhajpg6gx44KS44G144GP44KB44Gf5a6M5LqG44G+44Gn44Gu5omA6KaB5pmC6ZaT77yaIikKICAgIEZvciBpID0gMCBUbyAzCiAgICAgICAgQ2FsbCBjb3B5X3NoZWV0KEZ1bGxwYXRoKGkpLCBGcnNoZWV0KGkpLCBtYiwgVG9zaGVldChpKSkKICAgICAgICBtaWRkbGVUaW1lID0gVGltZXIKICAgICAgICBwcm9jZXNzVGltZSA9IG1pZGRsZVRpbWUgLSBzdGFydFRpbWUKICAgICAgICBEZWJ1Zy5QcmludCBUaXRsZShpKTsgcHJvY2Vzc1RpbWUgJiAi56eSIiAmIHZiQ3JMZgogICAgTmV4dAogICAgCiAgICBBcHBsaWNhdGlvbi5DYWxjdWxhdGlvbiA9IHhsQ2FsY3VsYXRpb25BdXRvbWF0aWMgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgJ+ioiOeul+OCkuiHquWLleOBqwogICAgQXBwbGljYXRpb24uRGlzcGxheUFsZXJ0cyA9IFRydWUgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICfnorroqo3jg6Hjg4Pjgrvjg7zjgrjjgpLplovlp4sKICAgIEFwcGxpY2F0aW9uLkVuYWJsZUV2ZW50cyA9IFRydWUgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAn44Kk44OZ44Oz44OI44KS6ZaL5aeLCiAgICBBcHBsaWNhdGlvbi5TY3JlZW5VcGRhdGluZyA9IFRydWUKCgogICAgRXhjZWwuRGlzcGxheUFsZXJ0cyA9IFRydWUgICAgICAn6K2m5ZGK44Oh44OD44K744O844K444KS44Kq44OzCiAgICBFeGNlbC5RdWl0ICAgICAgJ0V4Y2Vs57WC5LqGCgogICAgU2V0IEV4Y2VsID0gTm90aGluZyAgICAgICflj4LnhafjgpLop6PmlL4KICAgIE1zZ0JveCAi5pu444GN5o+b44GI44G+44GX44GfIgpFbmQgU3ViCgpQcml2YXRlIFN1YiBjb3B5X3NoZWV0KEJ5VmFsIEZ1bGxwYXRoIEFzIFN0cmluZywgQnlWYWwgRnJzaGVldCBBcyBTdHJpbmcsIEJ5UmVmIG1iIEFzIFdvcmtib29rLCBCeVZhbCBUb3NoZWV0IEFzIFN0cmluZykKICAgIERpbSBGd2IgQXMgV29ya2Jvb2sKICAgIERpbSBTb3VyY2VSbmcgQXMgUmFuZ2UKICAgIERpbSBUYXJnZXRSbmcgQXMgUmFuZ2UKICAgIFNldCBGd2IgPSBXb3JrYm9va3MuT3BlbihGdWxscGF0aCwgUmVhZE9ubHk6PVRydWUpICAgJ+iqreWPluOCiuWwgueUqOOBp+mWi+OBjwogICAgQWN0aXZlV2luZG93LlZpc2libGUgPSBGYWxzZQogICAgU2V0IFNvdXJjZVJuZyA9IEZ3Yi5Xb3Jrc2hlZXRzKEZyc2hlZXQpLlVzZWRSYW5nZQogICAgbWIuV29ya3NoZWV0cyhUb3NoZWV0KS5DZWxscy5DbGVhcgogICAgU2V0IFRhcmdldFJuZyA9IG1iLldvcmtzaGVldHMoVG9zaGVldCkuUmFuZ2UoIkExIikKICAgIFNvdXJjZVJuZy5Db3B5CiAgICBUYXJnZXRSbmcuUGFzdGVTcGVjaWFsIFBhc3RlOj14bFBhc3RlRm9ybXVsYXNBbmROdW1iZXJGb3JtYXRzCiAgICBUYXJnZXRSbmcuUGFzdGVTcGVjaWFsIFBhc3RlOj14bFBhc3RlQ29sdW1uV2lkdGhzCiAgICBBcHBsaWNhdGlvbi5DdXRDb3B5TW9kZSA9IEZhbHNlCiAgICBGd2IuQ2xvc2UKRW5kIFN1YgpQcml2YXRlIFN1YiBjb3B5X3NoZWV0MihCeVZhbCBGdWxscGF0aCBBcyBTdHJpbmcsIEJ5VmFsIEZyc2hlZXQgQXMgU3RyaW5nLCBCeVJlZiBtYiBBcyBXb3JrYm9vaywgQnlWYWwgVG9zaGVldCBBcyBTdHJpbmcpCiAgICBEaW0gRndiIEFzIFdvcmtib29rCiAgICBEaW0gU291cmNlUm5nIEFzIFJhbmdlCiAgICBEaW0gVGFyZ2V0Um5nIEFzIFJhbmdlCiAgICBTZXQgRndiID0gV29ya2Jvb2tzLk9wZW4oRnVsbHBhdGgsIFJlYWRPbmx5Oj1UcnVlKSAgICfoqq3lj5bjgorlsILnlKjjgafplovjgY8KICAgIEFjdGl2ZVdpbmRvdy5WaXNpYmxlID0gRmFsc2UKICAgIFNldCBTb3VyY2VSbmcgPSBGd2IuV29ya3NoZWV0cyhGcnNoZWV0KS5Vc2VkUmFuZ2UKICAgIG1iLldvcmtzaGVldHMoVG9zaGVldCkuQ2VsbHMuQ2xlYXIKICAgIFNldCBUYXJnZXRSbmcgPSBtYi5Xb3Jrc2hlZXRzKFRvc2hlZXQpLlJhbmdlKCJBMSIpCiAgICBTb3VyY2VSbmcuQ29weSBEZXN0aW5hdGlvbjo9VGFyZ2V0Um5nCiAgICBGd2IuQ2xvc2UKRW5kIFN1YgoK