a macro to Copy from multiple sheets to a new workbook without macro

[chingilou]

Hello everyone


under excel 2016 I have an xlsm workbook with several sheets which contain macros in the sheets themselves not only in the modules (can't do otherwise)


I would like to create a button that allows me to copy the sheets ("Hanifatoys", "Aternal", "Arba") to a new workbook in fpath&fname

-1-and this new workbook must not contain the macros of the sheets of the source file (even changing the extension during the "saveas" does not work)

-2- and also if possible to delete (not hide) the shapes that have the same "AAA" names from the sheets of the new workbook

-3- all this without formulas and without links in the new workbook


thank you

[snb]

Sub M_snb()
  Application.DisplayAlerts = False
  ThisWorkbook.SaveAs "G:\OF\without.xlsx", 51
End Sub

[chingilou]

hi snb still on the emergency call thanks again
I had already tested those, I have an error in the code of the copied sheets of the new workbook

Sub test001()
Worksheets(Array("Hanifatoys", "Aternal", "Arba")).Copy
With ActiveWorkbook
     .SaveAs FileName:=FPath & FName & ".xlsx", FileFormat:=xlOpenXMLWorkbook
     .Close SaveChanges:=False
End With


End Sub
'-------------------------------------------------
Sub test002()
Application.DisplayAlerts = False
'ThisWorkbook.Sheets.Copy
Sheets(Array("Hanifatoys", "Aternal", "Arba")).Copy
ActiveWorkbook.SaveAs FPath & FName & ".xlsx", 51
ActiveWorkbook.Close
'With Workbooks(Array("Hanifatoys", "Aternal", "Arba"))
'.SaveAs ThisWorkbook.Path & "\copy_001.xlsx", 51
'.Close
'End With
Application.DisplayAlerts = True
End Sub

[jolivanes]

Used your code but did some declaring.

Sub test001()
Dim FPath As String, FName As String
FPath = ThisWorkbook.Path    '<---- Change as required
FName = "Ola A New Book"    '<---- Change as required
Worksheets(Array("Hanifatoys", "Aternal", "Arba")).Copy
With ActiveWorkbook
     .SaveAs Filename:=FPath & "\" & FName & ".xlsx", FileFormat:=xlOpenXMLWorkbook
     .Close SaveChanges:=False
End With
End Sub

[chingilou]

thank you bro but it's the same
I will try to move the codes of the sheets concerned elsewhere so that it works
thanks anyway