12_入荷　カーゴ保存

Private Sub CommandButton1_Click()
コピー
連番
Workbooks("カーゴデータ.xlsm").Save
Range("G2").Activate
MsgBox "取込ました♪"
End Sub
--------------------------
Sub 連番()

Dim i As Integer
i = 1
Do While Cells(i + 1, "B").Value <> ""
  Cells(i + 1, "A").Value = i
  i = i + 1
  Loop

End Sub
---------------------------
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

 'チラついて五月蝿いのを防止
Application.ScreenUpdating = False

 Fdir = pathD & "05_入荷システム\"
FPss = Fdir & "JBRCシステム入荷.xlsm"
 FileName = FPss

flag = False

'今開いているブックを調べる
For Each Opnbook In Workbooks
 If Opnbook.FullName = FileName Then
 flag = True
 Exit For
 End If
 Next Opnbook

'目的のブックが開いてなければ開き、名前をセット
If flag = False Then
 Set Opnbook = Workbooks.Open(FileName)
 End If

'コピー元先のシートをセット
Set Z = Opnbook.Worksheets("カーゴ集計")
Set H = Workbooks("カーゴデータ.xlsm").Worksheets("カーゴ表")

'コピー元をアクティブにする
Opnbook.Activate

'コピペ　今回コピー元セルには計算があると仮定して、値で貼付けとしている
'２箇所コピペすることにしてある
Z.Range("A3:E53").Copy
 H.Range("B1").PasteSpecial Paste:=xlValues

 Z.Range("C2").Copy
 H.Range("H2").PasteSpecial Paste:=xlValues

'コピー元にもよるけど保存するか否かのダイアログがでたりするのでそれは表示させないで閉じる
Application.DisplayAlerts = False
 Opnbook.Close

'主たるブックをアクティブにする
Workbooks("カーゴデータ.xlsm").Activate
 H.Range("A1").Select

End Sub