Option Explicit
 
Sub 別ブックのすべてのセルを取得2()
 
    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(Excel, 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(ByRef Excel As Application, 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 = Excel.Workbooks.Open(Fullpath, ReadOnly:=True)   '読取り専用で開く
    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