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

[kcmuppet]

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:

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.

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?

 

[pbornemeier]

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]

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

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]

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.

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]

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]

Hello again @pbornemeier

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

 

[pbornemeier]

1) Remove the following line and the new workbook will stay open.

    NewWb.Close False

2) You can preserve column widths with an extra paste as shown in the last comment and line

    '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

 

[kcmuppet]

Thank you!

 

[Fluff]

Did not realize color did not work in the VBA block

If you want to format the code yourself, you can use the Rich Icon in the reply window.