Save current sheet as a new XLS and remove all Named Ranges

[sm789]

Hello,

I have a workbook with multiple sheets. I need to
Step 1: save one sheet as a new excel file;
Step 2: delete named ranges from this new saved file; and
Step 3: then delete the worksheet from the Original work book.

I have the following code which does step 1 and 3 very well.

' Step 1
' Save Current Worksheet as a new File

                Application.ScreenUpdating = False
                ActiveSheet.Copy
                With ActiveWorkbook
                    .SaveAs FileName:=sFileNameXLS, FileFormat:=51
                    .Close SaveChanges:=False
                End With
                Application.ScreenUpdating = True

'Step 3
' Delete the Temp Sheet
                Application.DisplayAlerts = False
                Sheets("Temp").Delete
                Application.DisplayAlerts = True

I also have the following code for Step 2. But I am struggling to figure out where to insert this code.

I DO NOT want to remove Named Ranges from the Original Workbook, I want to remove them from the new file saved.

'Step 3
' Remove all Names
 '               Dim MyName As Name
 '               For Each MyName In Names
 '               ActiveWorkbook.Names(MyName.Name).Delete
 '               Next:

 

[Alex Blakenburg]

Try something like this:

Sub CopySheetRemoveNames()


' Step 1
' Save Current Worksheet as a new File

                Dim wbNew As Workbook, wbOrig As Workbook
                Dim shtOrig As Worksheet
                Dim sFileNameXLS As String
                
                Set wbOrig = ActiveWorkbook
                Set shtOrig = wbOrig.Worksheets("Temp")     ' <-- Change as required
                sFileNameXLS = "Test"                       ' <-- I assume you have this somewhere already

                Application.ScreenUpdating = False
                shtOrig.Copy
                
                Set wbNew = ActiveWorkbook
                
                'Step 2
' Remove all Names
                Dim MyName As Name
                For Each MyName In wbNew.Names
                 wbNew.Names(MyName.Name).Delete
                Next:
                
                With wbNew
                    .SaveAs Filename:=sFileNameXLS, FileFormat:=51
                    .Close SaveChanges:=False
                End With
                Application.ScreenUpdating = True

'Step 3
' Delete the Temp Sheet
                Application.DisplayAlerts = False
                shtOrig.Delete
                Application.DisplayAlerts = True
                
End Sub

 

[sm789]

Thank you very much. I will test it out and come back with the results.