Save Workbook with existing Name in the Folder

[K]

Hi all, I have code below which save the current worksheet as
separate workbook in folder "Record"

Private Sub CommandButton17_Click()
Me.Select
Me.Copy
ActiveWorkbook.SaveAs Filename:="C:\Documents\Record\" & Left(Range
("A13").Value, Len(Range("A13").Value) - 5) & " ( " & Range
("D23").Value & " )" & ".xlsm", FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveWindow.Close
End Sub

I need some code to put in above macro which should check first if
there is any name of existing workbook in the folder which is same of
new workbook which is going to be save in that folder and if the names
are same then macro should put like 1 , 2 at the end of new workbook
name so it can be save. I want the same names but want to make them
different by putting numbers at the end of the workbookname like 1 ,
2 , 3 ..... etc. I hope i was able to explain my question. Please
can any friend can help

 

[smartin]

Hi all, I have code below which save the current worksheet as
separate workbook in folder "Record"

Private Sub CommandButton17_Click()
Me.Select
Me.Copy
ActiveWorkbook.SaveAs Filename:="C:\Documents\Record\" & Left(Range
("A13").Value, Len(Range("A13").Value) - 5) & " ( " & Range
("D23").Value & " )" & ".xlsm", FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveWindow.Close
End Sub

I need some code to put in above macro which should check first if
there is any name of existing workbook in the folder which is same of
new workbook which is going to be save in that folder and if the names
are same then macro should put like 1 , 2 at the end of new workbook
name so it can be save. I want the same names but want to make them
different by putting numbers at the end of the workbookname like 1 ,
2 , 3 ..... etc. I hope i was able to explain my question. Please
can any friend can help

Try this (untested) modification:

Private Sub CommandButton17_Click()
dim FileBase as string
dim TryName as String
dim j as long

Me.Select
Me.Copy

FileBase = "C:\Documents\Record\" & Left(Range
("A13").Value, Len(Range("A13").Value) - 5) & " ( " & Range
("D23").Value & " )"

j = -1
Do
j = j + 1
If j = 0 then
TryName = FileBase & ".xslm"
Else
TryName = FileBase & j & ".xslm"
End If
Loop Until Dir(TryName) = ""

ActiveWorkbook.SaveAs Filename:=TryName, FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveWindow.Close
End Sub

 

[K]

thanks lot smartin, man you are genious. The only thing I changed in
your macro was the file format which is "xlsm" and its working
superb. I been really looking forward for the answer as I am doing a
project and I needed this for that. Thanks again man

 

[smartin]

thanks lot smartin, man you are genious. The only thing I changed in
your macro was the file format which is "xlsm" and its working
superb. I been really looking forward for the answer as I am doing a
project and I needed this for that. Thanks again man

Good to know. Thanks for pointing out my typo (^: