Set wb1 = ThisWorkbook
lastShName = wb1.Sheets(Sheets.Count).Name
Set wb2 = Workbooks.Add
For Each ws In wb1.Sheets
If ws.Name <> lastShName Then
ws.Move After:=wb2.Sheets(wb2.Sheets.Count)
End If
Next ws
Set wb1 = ThisWorkbook
lastShName = wb1.Sheets(Sheets.Count).Name
Set wb2 = Workbooks.Add
For Each ws In wb1.Sheets
If ws.Name <> lastShName Then
ws.Move After:=wb2.Sheets(wb2.Sheets.Count)
End If
Next ws
Sub Delete_Last_Sheet()
Application.DisplayAlerts = False
Sheets(Sheets.Count).Delete
Call SaveFile_WithNewName
End Sub
Sub SaveFile_WithNewName()
Dim newName As String
newName = "NewWorkbook"
ActiveWorkbook.SaveAs Filename:=newName
End Sub