ActiveWorkbook.SaveCopyAs crashes excel on 2. run

[STGE2]

Hi<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o></o>
I’m working on an excel workbook where I need to take out 2 worksheets and save as another workbook.<o></o>
<o></o>
The code below runs fine the first time the macro is used in the workbook, but the second time excel craches! I don’t get an excel error report, only the standard Windows error screen:<o></o>
<o></o>
“Microsoft Office Excel has encountered a problem and needs to close. We are sorry for the inconvenience.”<o></o>
I can then as standard choose “Send error report” or “Don’t send”<o></o>
<o></o>
If I view the contents of the error report I get the following error signature:<o></o>
<o></o>
AppName: excel.exe AppVer: 11.0.8169.0 AppStamp:465f27bd<o></o>
ModName: excel.exe ModVer: 11.0.8169.0 ModStamp:465f27bd<o></o>
fDebug: 0 Offset: 000c0cee<o></o>
<o></o>
To determine where excel crashes I have put in some Msgboxes. When I run the macro the 2. time I only see the message “saveAs” and don’t get to the message “close”.<o></o>
<o></o>

[COLOR=black][FONT=Verdana]<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]Sub CopySheetsToNewWorkbook(ws As Worksheet)<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]  Dim NewName As String<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]  Dim nm As Name<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]  Dim sh As Shape<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]       <o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]  Application.ScreenUpdating = False<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]       <o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]      ' Copy specific sheets<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]      On Error GoTo ErrHandler<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]      sheets(Array("FrontPage", ws.Name)).Copy<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]      On Error GoTo 0<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]                                                          <o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]      'Remove buttons<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]      For Each sh In sheets(2).Shapes<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]          sh.Delete<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]      Next<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]                         <o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]      ' Remove named ranges<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]      For Each nm In ActiveWorkbook.Names<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]          nm.Delete<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]      Next nm<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]               <o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]      'Make dir to save TS<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]      On Error Resume Next<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]      MkDir (ThisWorkbook.path & "\TS")<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]      On Error GoTo 0<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]                       <o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]      ' Save it with the NewName and in the same directory as original<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]MsgBox "saveAs"<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]      ActiveWorkbook.SaveCopyAs ThisWorkbook.path & "\TS\" & ws.Name & "_" & ws.Range("I4") & ".xls"<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]MsgBox "close"<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]      ActiveWorkbook.Close SaveChanges:=False<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]      'Select the initial worksheet in initial workbook<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]      ws.Select<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]       <o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]      Application.ScreenUpdating = True<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]  Exit Sub<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]   <o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]ErrHandler:<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]  MsgBox "Specified sheets do not exist within this workbook"<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]End Sub<o:p></o:p>[/FONT][/COLOR]

<o></o>