Sub カーゴ表コピー()
Dim flag As Boolean
Dim Fdir As String
Dim FPss As String
Dim FileName As String
Dim Opnbook As Workbook
Dim Z As Worksheet
Dim H As Worksheet
'高速化開始
With Application
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
End With
Workbooks.Open FileName:="D:\JBRC検収システム\03_入力済データ\カーゴデータ.xlsm"
'コピー元先のシートをセット
Set Z = Workbooks("カーゴデータ.xlsm").Worksheets("カーゴ表")
'Set Z = Opnbook.Worksheets("カーゴ集計")
Set H = Workbooks("JBRCシステム入荷.xlsm").Worksheets("カーゴ集計")
'コピー元をアクティブにする
H.Activate
'コピペ 今回コピー元セルには計算があると仮定して、値で貼付けとしている
'2箇所コピペすることにしてある
H.Range("A2:D53").Copy
Z.Range("B2").PasteSpecial Paste:=xlValues
H.Range("G2").Copy
Z.Range("I7").PasteSpecial Paste:=xlValues
'コピー元にもよるけど保存するか否かのダイアログがでたりするのでそれは表示させないで閉じる
'Application.DisplayAlerts = False
' Opnbook.Close
'主たるブックをアクティブにする
'Workbooks("カーゴデータ.xlsm").Activate
' Z.Range("A1").Select
'高速化終了
With Application
.Calculation = xlCalculationAutomatic
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
コメントをお書きください