Save copy of worksheet but remain in old version

Question

I have a macro that takes inputs, pulls data for each input, and creates a separate sheet for each input and its data. It then saves the workbook as a new file. The problem is that once it saves the new file, the file I'm currently in becomes that new file.

Here is the code for reference:

Sub Generate()
    ' Generates reports for each order
    Dim WB As Workbook
    Set WB = ActiveWorkbook
    
    Dim ORD As Worksheet, LOT As Worksheet
    Set ORD = WB.Sheets("Orders")
    Set LOT = WB.Sheets("Order To Lot")
    
    Dim StartRow As Integer, RowCount As Integer, OrderCol As String, CurrOrder As String, ReportName As String
    StartRow = 3
    RowCount = ORD.Range("H1").Value
    OrderCol = "I"
    ReportName = ORD.Range("H2").Value
    
    For i = StartRow To StartRow + RowCount - 1
        Dim CurrLoc As String, CurrCell As Range
        CurrLoc = OrderCol & i
        Set CurrCell = ORD.Range(CurrLoc)
        
        If IsEmpty(CurrCell) Then
            Exit For
        Else
            CurrOrder = CurrCell.Value
            CreateSheet (CurrOrder)
            GetLotList (CurrOrder)
            
            Dim CO As Worksheet
            Set CO = ActiveWorkbook.Sheets(CurrOrder)
            
            CO.Range("A1").Value = "Order #:"
            CO.Range("B1").Value = "" & CurrOrder
            CO.Range("A" & 2 & ":L" & 2).Value = ORD.Range("A" & i & ":L" & i).Value
            
            Dim LotValues As Range, Dest As Range
            Set LotValues = Sheets("Order To Lot").Range("Table_Query_from_as400[#All]")
            LotValues.Copy
            Set Dest = CO.Range("A3")
            Dest.PasteSpecial xlPasteValues
            
            CO.Cells.EntireColumn.AutoFit
        End If
    Next i

    If Not IsEmpty("A3") Then
        WB.SaveAs GetFolder & "\" & ReportName & ".xlsm"
        ORD.Visible = xlSheetVeryHidden
        LOT.Visible = xlSheetVeryHidden
    End If
End Sub

Function CreateSheet(SheetName As String)
    Sheets.Add After:=ActiveWorkbook.Sheets("Order To Lot"), Type:=xlWorksheet
    ActiveWorkbook.Sheets("Order To Lot").Next.Name = SheetName
End Function

Function Refresh()
    ' Refreshes Query
    ThisWorkbook.Worksheets("Order To Lot").ListObjects("Table_Query_from_as400").QueryTable.Refresh BackgroundQuery:=False
End Function

Function GetLotList(OrderNo As String)
    ActiveWorkbook.Sheets("Order To Lot").Range("B1").Value = "" & OrderNo
    Refresh
End Function

Function GetFolder() As String
    Dim fldr As FileDialog
    Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    GetFolder = sItem
    Set fldr = Nothing
End Function

What I want to do is save a copy of the excel workbook in that current state so that I can then delete the generated sheets and "reset" things for the next time I want to use the report generator. Is this possible?

Answer 1

I ended up finding SaveCopyAs which solved my problem. It creates the copy without bringing me over to that copy.

Workbook.SaveCopyAs

Here is the updated code:

Sub Generate()
    ' Generates reports for each order
    Dim WB As Workbook
    Set WB = ActiveWorkbook
    
    Dim ORD As Worksheet, LOT As Worksheet
    Set ORD = WB.Sheets("Orders")
    Set LOT = WB.Sheets("Order To Lot")
    
    Dim StartRow As Integer, RowCount As Integer, OrderCol As String, CurrOrder As String, ReportName As String
    StartRow = 3
    RowCount = ORD.Range("H1").Value
    OrderCol = "I"
    ReportName = ORD.Range("H2").Value
    
    For i = StartRow To StartRow + RowCount - 1
        Dim CurrLoc As String, CurrCell As Range
        CurrLoc = OrderCol & i
        Set CurrCell = ORD.Range(CurrLoc)
        
        If IsEmpty(CurrCell) Then
            Exit For
        Else
            CurrOrder = CurrCell.Value
            CreateSheet (CurrOrder)
            GetLotList (CurrOrder)
            
            Dim CO As Worksheet
            Set CO = ActiveWorkbook.Sheets(CurrOrder)
            
            CO.Range("A1").Value = "Order #:"
            CO.Range("B1").Value = "" & CurrOrder
            CO.Range("A" & 2 & ":L" & 2).Value = ORD.Range("A" & i & ":L" & i).Value
            
            Dim LotValues As Range, Dest As Range
            Set LotValues = Sheets("Order To Lot").Range("Table_Query_from_as400[#All]")
            LotValues.Copy
            Set Dest = CO.Range("A3")
            Dest.PasteSpecial xlPasteValues
            
            CO.Cells.EntireColumn.AutoFit
        End If
    Next i
    
    If Not IsEmpty("A3") Then
        ORD.Visible = xlSheetVeryHidden
        LOT.Visible = xlSheetVeryHidden
        
        WB.SaveCopyAs GetFolder & "\" & ReportName & ".xlsm"
        
        ORD.Visible = xlSheetVisible
        LOT.Visible = xlSheetVisible
        
        DeleteSheets
    End If
End Sub

Function CreateSheet(SheetName As String)
    Sheets.Add After:=ActiveWorkbook.Sheets("Order To Lot"), Type:=xlWorksheet
    ActiveWorkbook.Sheets("Order To Lot").Next.Name = SheetName
End Function

Function Refresh()
    ' Refreshes Query
    ThisWorkbook.Worksheets("Order To Lot").ListObjects("Table_Query_from_as400").QueryTable.Refresh BackgroundQuery:=False
End Function

Function GetLotList(OrderNo As String)
    ActiveWorkbook.Sheets("Order To Lot").Range("B1").Value = "" & OrderNo
    Refresh
End Function

Function GetFolder() As String
    Dim fldr As FileDialog
    Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    GetFolder = sItem
    Set fldr = Nothing
End Function

Function DeleteSheets()
    Application.DisplayAlerts = False
    
    For Each Sheet In ActiveWorkbook.Sheets
        If Sheet.Name <> "Orders" And Sheet.Name <> "Order To Lot" Then
            Sheet.Delete
        End If
    Next
    
    Application.DisplayAlerts = True
End Function

The relevant change for this question being on Line 50:

WB.SaveCopyAs GetFolder & "\" & ReportName & ".xlsm"