6_入荷 カーゴ表変更

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