VBA to save active sheet as new xlsx (and remove VBA from active sheet)

kcmuppet

Active Member
Joined
Nov 2, 2005
Messages
260
Office Version
  1. 365
  2. 2010
Hello,

I've been trying to combine some examples of the SaveAs techniques, but haven't been successful, and would greatly appreciate some help.

I'm trying to save a copy of the a worksheet only (specific Sheet9 "Report" if ActiveSheet is not possible)
- as a formatted file without macros in it (.xlsx)
- giving a default filename
- defaulting to the path of the currently open workbook
- allowing the user to select a folder
- suppressing any warnings/alerts about removing VBA
- leaving the new workbook open (and keeping the old one open in the backgroud.

This does exactly that for PDF:

VBA Code:
Private Sub SaveReportAsPDF()
  
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Range("B1"), Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True

End Sub

But for saving as .xlsx what I have so far is below, but it seems to be stuck with my attempt to block alerts, and never gets round to saving the file.

VBA Code:
Sub SaveActiveSheetasXLSXWithoutVBA()
        Dim NewWb As Workbook
        Dim fname As Variant
        
        fname = Application.GetSaveAsFilename(InitialFileName:=Range("B1"), filefilter:= _
            " Excel Macro Free Workbook (*.xlsx), *.xlsx,")

        'Set FileFormat to .xlsx
            FileFormatValue = 51
          
        'Copies the ActiveSheet to new workbook
                ActiveSheet.Copy
                Set NewWb = ActiveWorkbook
              
Application.DisplayAlerts = False
                'Save the file
                NewWb.SaveAs fname, FileFormat:= _
                             FileFormatValue, CreateBackup:=False
                NewWb.Close False
                Set NewWb = Nothing
Application.DisplayAlerts = True

End Sub

Could somebody point me in the right direct please?
 

Some videos you may like

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).

pbornemeier

Well-known Member
Joined
May 24, 2005
Messages
3,884
The code as is worked for me. Was your value for fname a valid workbook name? Since the .SaveAs command is in the DisplayAlerts = False area, that will not be checked and would cause the save to fail.
 

kcmuppet

Active Member
Joined
Nov 2, 2005
Messages
260
Office Version
  1. 365
  2. 2010
The code as is worked for me. Was your value for fname a valid workbook name? Since the .SaveAs command is in the DisplayAlerts = False area, that will not be checked and would cause the save to fail.

Hi thanks for your reply. Yes the fname is correct but it's not working for me.

I tried an alternative approach Application.DisplayAlerts to help the user past the alien-sounding VB project warning, with a less than ideal message box forewarning them, but it's still not robust because if I click 'Cancel' when promoted to select a path, it still goes to the VB warning and then tries to save the file as FALSE.xlsx, then if I click 'No' when promoted to overwrite if the file already exists, I get a red cross message box "400".


VBA Code:
Sub SaveThisReport()
   
   Dim NewWb As Workbook
   Dim fname As Variant
   
   MsgBox "About to save a copy of this sheet only, in an Excel file without macros." & vbNewLine & vbNewLine & "Choose where to save it and then click 'Yes' when prompted to save as a macro-free file."
   
   fname = Application.GetSaveAsFilename(InitialFileName:=Range("B1"), filefilter:=" Excel Macro Free Workbook (*.xlsx), *.xlsx,")
      
   ActiveSheet.Copy
   
   Set NewWb = ActiveWorkbook
   
   NewWb.SaveAs fname, FileFormat:=51, CreateBackup:=False
      
   NewWb.Close False
   
   Set NewWb = Nothing
   
End Sub
 

pbornemeier

Well-known Member
Joined
May 24, 2005
Messages
3,884
An ugly way to get around the message would be to copy the entire worksheet to a new worksheet (with no code) then move the new worksheet.

VBA Code:
Option Explicit

Sub SaveActiveSheetasXLSXWithoutVBA()
    Dim NewWb As Workbook
    Dim fname As Variant
    Dim sSheetName As String
    Dim FileFormatValue As Long
    
    fname = Application.GetSaveAsFilename(InitialFileName:=Range("B1"), _
        filefilter:=" Excel Macro Free Workbook (*.xlsx), *.xlsx,")
    
    'Set FileFormat to .xlsx
    FileFormatValue = 51
    
    'Copy data, lose sheet code
    sSheetName = ActiveSheet.Name
    ActiveSheet.Name = "XYZZY"
    Worksheets.Add(before:=Sheets("XYZZY")).Name = sSheetName
    With Worksheets("XYZZY")
        .Range(.Range("A1"), .Range("A1").SpecialCells(xlLastCell)).Copy _
            Destination:=Worksheets(sSheetName).Range("A1")
    End With
    Worksheets(sSheetName).Activate
    
    'Moves the ActiveSheet to new workbook
    ActiveSheet.Move
    Set NewWb = ActiveWorkbook
    
    'Save the file
    NewWb.SaveAs fname, FileFormat:= _
        FileFormatValue, CreateBackup:=False
    NewWb.Close False
    Set NewWb = Nothing
    
    Worksheets("XYZZY").Name = sSheetName
    
End Sub
 

kcmuppet

Active Member
Joined
Nov 2, 2005
Messages
260
Office Version
  1. 365
  2. 2010

ADVERTISEMENT

That's a great idea and works well - Thank you.

Do you know of way to keep the new file open (i.e. to have the same effect as for the ActiveSheet.ExportAsFixedFormat option, "OpenAfterPublish:=True "?
 

kcmuppet

Active Member
Joined
Nov 2, 2005
Messages
260
Office Version
  1. 365
  2. 2010
Hello again @pbornemeier

Is there a way to avoid copying things like buttons and to preserve column widths?
 

pbornemeier

Well-known Member
Joined
May 24, 2005
Messages
3,884

ADVERTISEMENT

1) Remove the following line and the new workbook will stay open.
VBA Code:
    NewWb.Close False

2) You can preserve column widths with an extra paste as shown in the last comment and line
VBA Code:
    'Copy data, lose sheet code
    sSheetName = ActiveSheet.Name
    ActiveSheet.Name = "XYZZY"
    Worksheets.Add(before:=Sheets("XYZZY")).Name = sSheetName
    With Worksheets("XYZZY")
        .Range(.Range("A1"), .Range("A1").SpecialCells(xlLastCell)).Copy _
            Destination:=Worksheets(sSheetName).Range("A1")
    End With
    Worksheets(sSheetName).Activate
    'The copied range is still in the clipboard
    Range("A1").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

Did not realize color did not work in the VBA block
 
Solution

Watch MrExcel Video

Forum statistics

Threads
1,123,359
Messages
5,601,153
Members
414,431
Latest member
JustmemyselfandI

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top