vba: saveas in xlsm fileformat without changing the active workbook

Miqi180 picture Miqi180 · Aug 9, 2014 · Viewed 8k times · Source

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?

Answer

L42 picture L42 · Aug 9, 2014

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.