Export sheet, save as new sheet. Efficiently

[ItalianPlatinum]

Hello - I have the below code that works. But I wanted to know if there was a more efficient way of doing what I am trying to accomplish or a correct way I should say. All I am trying to do is export out a sheet to a new workbook removing all formulas and macro buttons then saving as.

'Export file, set filters and save-as
Sheets("COMPARE").Copy
Sheets("COMPARE").Unprotect
Sheets("COMPARE").Cells.Copy
Range("A1").Select
ActiveCell.PasteSpecial xlPasteValues
ActiveSheet.Buttons.Delete
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, AllowFiltering:=True
ActiveWorkbook.SaveAs Filename:="C:\my folder.xlsm"

 

[DanteAmor]

Maybe with the following it will be a little faster.

Sub copysheet()
  'Export file, set filters and save-as
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  
  Sheets("COMPARE").Copy
  With ActiveSheet
    .Unprotect
    .Cells.Copy
    .Range("A1").PasteSpecial xlPasteValues
    .Buttons.Delete
    .Protect DrawingObjects:=True, Contents:=True, AllowFiltering:=True
  End With

  With ActiveWorkbook
    .SaveAs Filename:="C:\my folder\my file.xlsx"
    .Close False
  End With
  
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic

End Sub

 

[ItalianPlatinum]

Tha

Maybe with the following it will be a little faster.

Sub copysheet()
  'Export file, set filters and save-as
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
 
  Sheets("COMPARE").Copy
  With ActiveSheet
    .Unprotect
    .Cells.Copy
    .Range("A1").PasteSpecial xlPasteValues
    .Buttons.Delete
    .Protect DrawingObjects:=True, Contents:=True, AllowFiltering:=True
  End With

  With ActiveWorkbook
    .SaveAs Filename:="C:\my folder\my file.xlsx"
    .Close False
  End With
 
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic

End Sub

thank you i will put it to use and let you know! i am sure it will work great. much appreciated

 

[ItalianPlatinum]

Tha

thank you i will put it to use and let you know! i am sure it will work great. much appreciated

One slight problem i am trying to saveas the workbook in .xlsm but receiving this error message

    .SaveAs Filename:="C:\my folder\my file.xlsx"

 

[DanteAmor]

Change this line:

.SaveAs Filename:="C:\my folder\my file.xlsx"

for this:

.SaveAs "C:\my folder\my file.xlsm", xlOpenXMLWorkbookMacroEnabled

 

[ItalianPlatinum]

Change this line:

.SaveAs Filename:="C:\my folder\my file.xlsx"

for this:

.SaveAs "C:\my folder\my file.xlsm", xlOpenXMLWorkbookMacroEnabled

WORKS! THANKS!!

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.

 

[ItalianPlatinum]

I'm glad to help you. Thanks for the feedback.

if i wanted the ability to save over the file if it already exists how do i modify to accommodate that?

.SaveAs "C:\my folder\my file.xlsm", xlOpenXMLWorkbookMacroEnabled

 

[DanteAmor]

Try this

Sub copysheet()
  'Export file, set filters and save-as
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  Application.DisplayAlerts = False
  
  Sheets("COMPARE").Copy
  With ActiveSheet
    .Unprotect
    .Cells.Copy
    .Range("A1").PasteSpecial xlPasteValues
    .Buttons.Delete
    .Protect DrawingObjects:=True, Contents:=True, AllowFiltering:=True
  End With

  With ActiveWorkbook
    .SaveAs "C:\my folder\my file.xlsm", xlOpenXMLWorkbookMacroEnabled
    .Close False
  End With
  
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic

End Sub

 

[ItalianPlatinum]

Try this

Sub copysheet()
  'Export file, set filters and save-as
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  Application.DisplayAlerts = False
 
  Sheets("COMPARE").Copy
  With ActiveSheet
    .Unprotect
    .Cells.Copy
    .Range("A1").PasteSpecial xlPasteValues
    .Buttons.Delete
    .Protect DrawingObjects:=True, Contents:=True, AllowFiltering:=True
  End With

  With ActiveWorkbook
    .SaveAs "C:\my folder\my file.xlsm", xlOpenXMLWorkbookMacroEnabled
    .Close False
  End With
 
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic

End Sub

It is asking me with a dialog box if i want to replace the file that exists. is there a way to just auto save it over?