I have the following code which makes copies of the active workbook and gives each copy a different name. It works well, BUT I really need the original worksheet from which the code is run to stay active.
If I use the SaveCopyAs
function instead, the copied files do not have the correct file format (.xlsm), and you cannot specify the file format as a parameter as in the saveAs
function.
http://msdn.microsoft.com/en-us/library/bb178003%28v=office.12%29.aspx
http://msdn.microsoft.com/en-us/library/office/ff841185%28v=office.15%29.aspx
Sub makeCopies()
Dim name As Range, team As Range
Dim uName As String, fName As String, fFormat As String
Dim location as string, nName as string
location ="c:\test\"
nName = "Test - Team "
Set team = Names("Team").RefersToRange
For Each name In team
uName = nName & name.Value
fName = location & uName
fFormat = ThisWorkbook.FileFormat
ActiveWorkbook.SaveAs FileName:=fName, FileFormat:=fFormat
Next name
End sub
The best I can think of is to first make the copies with saveCopyAs
and then access each file, save it in the correct file format with saveAs
and then close it, but that means double work, and I would really hate to do that. Is there a smarter way?
This works form me. SaveCopyAs
saves the workbook in the exact same format.
Sub makeCopies()
Dim name As Range, team As Range
Dim uName As String, fName As String, tempname As String
Dim location As String, nName As String
location = "C:\Test\"
nName = "Test - Team "
Set team = ThisWorkbook.Names("Team").RefersToRange
For Each name In team
uName = nName & name.Value
fName = location & uName & "." & _
Split(ThisWorkbook.FullName, ".") _
(UBound(Split(ThisWorkbook.FullName, ".")))
ThisWorkbook.SaveCopyAs fName
Next name
End Sub
Is this what you're trying? Tried and tested.