Sub 別ブックのすべてのセルを取得()
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 '警告メッセージをオフ
Dim Wb1 As Workbook, Wb2 As Workbook, Wb3 As Workbook, Wb4 As Workbook
Dim FullPath1 As String, FullPath2 As String, FullPath3 As String, FullPath4 As String
Dim SourceRng1 As Range, SourceRng2 As Range, SourceRng3 As Range, SourceRng4 As Range
Dim TargetRng1 As Range, TargetRng2 As Range, TargetRng3 As Range, TargetRng4 As Range
'Dim AllmydataArr1 As Variant, AllmydataArr2 As Variant, AllmydataArr3 As Variant, AllmydataArr4 As Variant
'Dim AllmydataArr11 As Variant, AllmydataArr12 As Variant, AllmydataArr13 As Variant, AllmydataArr14 As Variant
'------------------------------------------------------------------------ここまで
'↑ここまでは上記サンプルコードと同一↑
'メイン処理0の時間をイミディエイトウィンドウに出力
middleTime = Timer
processTime = middleTime - startTime
Debug.Print "メイン処理0の終了:"; processTime & "秒" & vbCrLf
'Call メイン処理0の終了
Dim ws As Worksheet
Dim filename As String
Dim wb As Workbook
Worksheets("kyu").Cells.Clear
Worksheets("nyu").Cells.Clear
Worksheets("gai").Cells.Clear
Worksheets("折衝取込").Cells.Clear
' With Worksheets(Array("kyu", "nyu", "gai", "折衝取込"))
' Cells.Clear
' End With
'貼り付け先のブック
filename = ThisWorkbook.Path & "\" & "ワークシート.xlsm"
Set mb = Workbooks.Open(filename)
'------------------------------------------------------------------------1ここから
'開くExcelファイルを指定
FullPath1 = "C:\Users\名前\Desktop\Excelフォルダ" & "\" & "配信スケジュール .xlsm" ' "救急患者集計.xlsm"
Set Wb1 = Excel.Workbooks.Open(FullPath1, ReadOnly:=True) '読取り専用で開く
Set SourceRng1 = Wb1.Worksheets("sheet5").UsedRange
' AllmydataArr1 = SourceRng1
' AllmydataArr11 = SourceRng1.NumberFormat
Set TargetRng1 = mb.Worksheets("kyu").Range("A1")
' TargetRng1.Resize(UBound(AllmydataArr1, 1), UBound(AllmydataArr1, 2)) = AllmydataArr1
' TargetRng1.Resize(UBound(AllmydataArr1, 1), UBound(AllmydataArr1, 2)) = AllmydataArr11
SourceRng1.Copy
TargetRng1.PasteSpecial Paste:=xlPasteFormulasAndNumberFormats
TargetRng1.PasteSpecial Paste:=xlPasteColumnWidths
Application.CutCopyMode = False
'------------------------------------------------------------------------ここまで
'メイン処理1の時間をイミディエイトウィンドウに出力
middleTime = Timer
processTime = middleTime - startTime
Debug.Print "未納本文処理1の終了:"; processTime & "秒" & vbCrLf
'Call 未納本文処理1の終了
'------------------------------------------------------------------------2ここから
'開くExcelファイルを指定
FullPath2 = "C:\Users\名前\Desktop\Excelフォルダ" & "\" & "未納本文.xlsm" ' "救急患者集計.xlsm""未納整理簿.xlsm"
Set Wb2 = Excel.Workbooks.Open(FullPath2, ReadOnly:=True) '読取り専用で開く
Set SourceRng2 = Wb2.Worksheets("未納本文").UsedRange
Set TargetRng2 = mb.Worksheets("nyu").Range("A1")
SourceRng2.Copy
TargetRng2.PasteSpecial Paste:=xlPasteFormulasAndNumberFormats
TargetRng2.PasteSpecial Paste:=xlPasteColumnWidths
Application.CutCopyMode = False
'------------------------------------------------------------------------ここまで
'メイン処理2の時間をイミディエイトウィンドウに出力
middleTime = Timer
processTime = middleTime - startTime
Debug.Print "全部1処理2の終了:"; processTime & "秒" & vbCrLf
'Call 全部1処理2の終了
'------------------------------------------------------------------------3ここから
'開くExcelファイルを指定
FullPath3 = "C:\Users\名前\Desktop\Excelフォルダ" & "\" & "未納本文.xlsm" ' "救急患者集計.xlsm""未納整理簿.xlsm"
Set Wb3 = Excel.Workbooks.Open(FullPath3, ReadOnly:=True) '読取り専用で開く
Set SourceRng3 = Wb3.Worksheets("全部1").UsedRange
Set TargetRng3 = mb.Worksheets("gai").Range("A1")
SourceRng3.Copy
TargetRng3.PasteSpecial Paste:=xlPasteFormulasAndNumberFormats
TargetRng3.PasteSpecial Paste:=xlPasteColumnWidths
Application.CutCopyMode = False
'------------------------------------------------------------------------ここまで
'メイン処理3の時間をイミディエイトウィンドウに出力
middleTime = Timer
processTime = middleTime - startTime
Debug.Print "未納本文処理3の終了:"; processTime & "秒" & vbCrLf
'Call 未納本文処理3の終了
'------------------------------------------------------------------------4ここから
'開くExcelファイルを指定
FullPath4 = "C:\Users\名前\Desktop\Excelフォルダ" & "\" & "未納本文.xlsm" ' "救急患者集計.xlsm""未収金折衝状況表.xlsm"
Set Wb4 = Excel.Workbooks.Open(FullPath4, ReadOnly:=True) '読取り専用で開く
Set SourceRng4 = Wb4.Worksheets("未納本文").UsedRange
Set TargetRng4 = mb.Worksheets("折衝取込").Range("A1")
SourceRng4.Copy
TargetRng4.PasteSpecial Paste:=xlPasteFormulasAndNumberFormats
TargetRng4.PasteSpecial Paste:=xlPasteColumnWidths
Application.CutCopyMode = False
Workbooks("ワークシート.xlsm").Worksheets("sheet1").Range("A1").Copy
'------------------------------------------------------------------------ここまで
'メイン処理4の時間をイミディエイトウィンドウに出力
middleTime = Timer
processTime = middleTime - startTime
Debug.Print "全部1をふくめた完了までの所要時間:"; processTime & "秒" & vbCrLf
'Call 全部1をふくめた完了までの所要時間
'------------------------------------------------------------------------'↓ここから下は上記サンプルコードと同一↓
Application.Calculation = xlCalculationAutomatic '計算を自動に
Application.DisplayAlerts = True '確認メッセージを開始
Application.EnableEvents = True 'イベントを開始
Application.ScreenUpdating = True
Excel.DisplayAlerts = True '警告メッセージをオン
Excel.Quit 'Excel終了
Set Excel = Nothing '参照を解放
MsgBox "書き換えました"
E