Search code examples
excelsave-asxlsmvba

vba: saveas in xlsm fileformat without changing the active workbook


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?


Solution

  • 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.