Save a sheet to a new workbook - Macro

Hello - I am trying to save specific cells from one workbook into another workbook with the click of a command button.

I would like to save a specific dynamic area into a new workbook, I have created a new object name for this dynamic table as "Template_Table", so this is the area that needs to be saved into a new workbook ---- I do not know how to implement his part in my code below, any suggestions?

I would like a dialog to popup to ask the use what they would like to name the new workbook when they click the command button, is this possible?

I have the code below thus far, but I have an "Run Time 1004, Application Defined or Object Defined Error" -- Any idea what is going on? And how I can fix this?

Thank you for your help.




Dim NewName As String
Dim nm As Name
Dim ws As Worksheet

If MsgBox("Copy specific sheets to a new workbook" & vbCr & _
"Save new workbook as 'H0J0XXXXXX BOM'" _
, vbYesNo, "Create BOM") = vbNo Then Exit Sub

With Application
.ScreenUpdating = False


On Error GoTo ErrCatcher
Sheets(Array("BOM")).Copy
On Error GoTo 0

' Paste sheets as values
' Remove External Links, Hperlinks and hard-code formulas
' Make sure A1 is selected on all sheets
For Each ws In ActiveWorkbook.Worksheets
ws.Cells.Copy
ws.[A1].PasteSpecial Paste:=xlValues
ws.Cells.Hyperlinks.Delete
Application.CutCopyMode = False
Cells(1, 1).Select
ws.Activate
Next ws
Cells(1, 1).Select


For Each nm In ActiveWorkbook.Names
nm.Delete
Next nm


NewName = InputBox("Please Specify the name of your new workbook", "New Copy")


ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & NewName & ".xls"
ActiveWorkbook.Close SaveChanges:=False

.ScreenUpdating = True
End With
Exit Sub

ErrCatcher:
MsgBox "Specified sheets do not exist within this workbook"

End Sub

Did you have time to read the forum rules?
Have a good read, in this case pay special attention to #3.

Sorry about that - I thought I had clicked the ##
I'll repost.