How to save filename with -v2 -v3 and so on at the end if file name already exists

I have the following code and I want to change it such that:
1) if the file name C:\abc.xlsx already exists, it will save as C:\abc-v2.xlsx;
2) if both the file name C:\abc.xlsx and C:\abc-v2.xlsx already exist, it will save as abc-v3.xlsx;
...so on and so forth.

[VBA]Sub copysavefile()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Sheets(Array("1", "18")).Select
Sheets("37").Activate
Sheets(Array("1", "18")).Copy
Sheets("1").Name = "summary"
Sheets("18").Name = "main"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
ActiveWorkbook.SaveAs Filename:= "C:\abc.xlsx" , FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
MsgBox ("Complete creating " & Range("J2").Value & ".")
ActiveWindow.Close 'ActiveWorkbook.Close savechanges = True
End Sub[/VBA]


Thanks in advance! :friends:

Hi Surii,

Here's a try:
[VBA]Option Explicit

Sub CopySaveFile()
Dim FSO As Object
Dim wb As Workbook
Dim Path As String
Dim FileName As String
Dim VerNumber As String
Dim n As Long

Const EXT As String = ".xlsm"

Set FSO = CreateObject("Scripting.FileSystemObject")
Path = ThisWorkbook.Path & "\"
FileName = "abc"

If FSO.FileExists(Path & FileName & EXT) Then

n = 2
VerNumber = "-v" & CStr(n)

Do While FSO.FileExists(Path & FileName & VerNumber & EXT)
n = n + 1
VerNumber = "-v" & CStr(n)
Loop
End If

Set wb = Workbooks.Add(xlWBATWorksheet)

ThisWorkbook.Worksheets(Array("1", "18")).Copy wb.Worksheets(1)
wb.Worksheets(1).Name = "summary"
wb.Worksheets(2).Name = "main"
Application.DisplayAlerts = False
wb.Worksheets(3).Delete
Application.DisplayAlerts = True
wb.SaveAs Path & FileName & VerNumber & EXT, xlOpenXMLWorkbookMacroEnabled
wb.Close False
End Sub[/VBA]
Mark

Thanks very much for your help. It works quite ok except that in the end there is an error in "wb.SaveAs" function (the last second row). I can't find out what the problem is.. :help

[VBA]Option Explicit

Sub CopySaveFile()
Dim FSO As Object
Dim wb As Workbook
Dim Path As String
Dim FileName As String
Dim FileType As String
Dim VerNumber As String
Dim n As Long

Const EXT As String = ".xlsm"

Set FSO = CreateObject("Scripting.FileSystemObject")
Path = Range("J1").Value 'C:\Documents\
FileName = Range("J3").Value 'abc

If FSO.FileExists(Path & FileName & EXT) Then

n = 2
VerNumber = "_v" & CStr(n)

Do While FSO.FileExists(Path & FileName & VerNumber & EXT)
n = n + 1
VerNumber = "_v" & CStr(n)
Loop
End If

Set wb = Workbooks.Add(xlWBATWorksheet)

ThisWorkbook.Worksheets(Array("1", "18")).Copy wb.Worksheets(1)
wb.Worksheets(1).Name = "summary"
wb.Worksheets(2).Name = "main"
Application.DisplayAlerts = False
wb.Worksheets(3).Delete
Application.DisplayAlerts = True
wb.SaveAs Path & FileName & VerNumber & EXT 'C:\Documents\abc_v2.xlsm
wb.Close False
End Sub[/VBA]

Quickly looking (off to bed), but you left off the file type. I am still "new" to 2010 (or more accurately, 2007 and thereafter), but seem to recall that as more important than the extension. That is, when tested in 2010, I could dicth 'EXT' is the SaveAs, but I left the type.

Oh thanks very much! I originally thought the error comes from the filetype because my original codes (before your help) was without the filetype and it worked. Knowing that your codes need the filetype, now I found out it's actually my range got typo in the file... Thanks heaps, nice of you, and CHEERS :beerchug:

You are most welcome and glad you got it working:)

.