| 
    
     |  | ▼もとあし さん: ブックAからしかマクロで作成しないのなら、
 どこかのセルに数値を保存しておけばナンバーリングできるのでは?
 
 Option Explicit
 
 Sub test()
 
 Dim MyPath As String
 Dim MyBook As String
 Dim wb As Workbook
 
 MyPath = Replace(ThisWorkbook.Path, "フォルダA", "フォルダB")
 MyBook = Mid(ThisWorkbook.Name, 1, Len(ThisWorkbook.Name) - 4)
 
 Set wb = Workbooks.Add
 
 With ThisWorkbook.Worksheets(1)
 Do Until Dir(MyPath & "\" & MyBook & "_" & .Range("A1").Value & ".xls") = ""
 .Range("A1").Value = .Range("A1").Value + 1
 Loop
 wb.SaveAs Filename:=MyPath & "\" & MyBook & "_" & .Range("A1").Value & ".xls"
 End With
 wb.Close
 Set wb = Nothing
 End Sub
 
 
 |  |