title: Workbook becomes corrupted and won't open after macro saves with certain number of sheets
body: <p>In one excel instance (Instance A), my workbook (Workbook A) performs calculations based on user inputs and creates a worksheet with a chart object.  This worksheet is copied and pasted into another workbook (Workbook B), which is closed in Instance A and then opened in a second excel instance (Instance B).  Workbook B/Instance B are kept open and in a separate window, as the function of Workbook A/Instance A is to create worksheets to be viewed in Workbook B/Instance B.</p>
  
  <p>So the macro process is: Worksheet is created in Instance A/Workbook A -> Workbook B is closed in Instance B -> Workbook B is opened in Instance A -> worksheet is copied from Workbook A to Workbook B -> Workbook B is saved/closed in Instance A -> Workbook B is opened in Instance B</p>
  
  <p>In the interest of full disclosure, this is the entire sub:</p>
  
  <pre><code>Sub CopySSToNewWorkbook()
  
  
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  Application.Calculation = xlCalculationManual
  
  Dim MoveFromWkb As Workbook
  Dim MoveFromSht As Worksheet
  Dim ChartName As String
  Dim RngToCover As Range
  Dim duplicateChtPic As Shape
  Dim NewSheetName As String
  
  Dim TagString As String
  If InputPage.Range("PanelTag") &lt;&gt; "" Then TagString = "-" &amp; InputPage.Range("PanelTag").Text
  
  Set MoveFromWkb = ThisWorkbook
  'Set MoveFromSht = MoveFromWkb.Sheets("InputPage")
  If InputPage.Range("PgNum") &lt;&gt; "" Then
      NewSheetName = InputPage.Range("RoomNum").Text &amp; TagString &amp; " (Pg" &amp; InputPage.Range("PgNum") &amp; ")"
      Set MoveFromSht = MoveFromWkb.Worksheets(NewSheetName)
  Else
      NewSheetName = InputPage.Range("RoomNum").Text &amp; TagString
      Set MoveFromSht = MoveFromWkb.Worksheets(NewSheetName)
  End If
  
  Set RngToCover = MoveFromSht.Range("E19:Y34")
  
  ChartName = "Panel" &amp; InputPage.Range("PgNum")
  
  'Duplicate method
  Set duplicateChtPic = MoveFromSht.ChartObjects(ChartName).Duplicate()
  MoveFromSht.Shapes(ChartName).Delete
  duplicateChtPic.ZOrder msoSendToBack
  duplicateChtPic.Select
  Call DelinkChartFromData
  
  
  With duplicateChtPic
      .height = RngToCover.height ' resize
      .Width = RngToCover.Width   ' resize
      .top = RngToCover.top - 2     ' reposition
      .Left = RngToCover.Left - 6 ' reposition
  
  End With
  
  MoveFromSht.Shapes("SaveSpoolSheetButton").Delete
  MoveFromSht.Shapes("EditSpoolSheetButton").Visible = msoTrue
  MoveFromSht.Shapes("UpdatePageNumberButton").Visible = msoTrue
  MoveFromSht.Shapes("DeletePanelButton").Visible = msoTrue
  
  
  Dim CNumber As String
  Dim RelNum As String
  Dim CrtNum As String
  Dim Percentage As String
  Dim SSFolderName As String
  Dim Wkbname As String
  Dim FileLocation As String
  Dim Sht As Worksheet
  Dim SSCopyYesNo As Integer
  Dim DoubleSheet As Boolean
  Dim MoveToWkb As Workbook
  Dim MoveToSht As Worksheet
  Dim PasteSheet As Worksheet
  Dim CellName As name
  Dim SheetCounter As Integer
  
  SheetCounter = 1
  
  Dim i As Integer
  Dim varLinks As Variant
  
  With InputPage
      CNumber = .Range("JNumber").Text
      CrtNum = "Crt" &amp; .Range("CrateNum").Text
      RelNum = "Rel" &amp; .Range("RelNum").Text
      Percentage = (.Range("RelPct").value * 100) &amp; "Pct"
  End With
  
  If CNumber &lt;&gt; "" Then
      Wkbname = Wkbname &amp; CNumber
  End If
  
  If RelNum &lt;&gt; "Rel" Then
      Wkbname = Wkbname &amp; "_" &amp; RelNum
  End If
  
  If CrtNum &lt;&gt; "Crt" Then
      Wkbname = Wkbname &amp; "_" &amp; CrtNum
  End If
  
  If Percentage &lt;&gt; "0Pct" Then
      Wkbname = Wkbname &amp; "_" &amp; Percentage
  End If
  
  SSFolderName = CreateSSFolders
  FileLocation = SSFolderName &amp; "\" &amp; Wkbname &amp; ".xlsb"
  
  
  Dim newXL As Excel.Application
  
  
  'Set newXL = GetObject(FileLocation).Application
  If IsFileOpen(FileLocation) = True Then
      Set newXL = GetObject(FileLocation).Application
  
      newXL.Application.ScreenUpdating = False
      newXL.DisplayAlerts = False
      newXL.Application.Workbooks(Wkbname &amp; ".xlsb").Close SaveChanges:=False
  '    newXL.Application.Quit
  
  
  
  '    Set newXL = Nothing
  Else
      Set newXL = CreateObject("Excel.Application")
      newXL.Visible = True
  End If
  
  
  If FileFolderExists(FileLocation) Then
  '    newXL.Application.ScreenUpdating = False
  '    newXL.Application.DisplayAlerts = False
  
  '    On Error Resume Next
  '    newXL.Workbooks(Wkbname &amp; ".xlsb").Close SaveChanges:=False
  '    On Error GoTo 0
  
      Workbooks.Open FileLocation, UpdateLinks:=False, ReadOnly:=False
  
      Set MoveToWkb = Workbooks(Wkbname &amp; ".xlsb")
  Else
      Workbooks.Open (InputPage.MainFolderLocation.Text &amp; "calc_and_trans\SpoolSheetWorkbookTemplate.xlsb")
      Set MoveToWkb = Workbooks("SpoolSheetWorkbookTemplate.xlsb")
  
      'if SSFolder doesn't already exist, the EditSpoolSheet module is imported to the new spoolsheet
      'it is also exported to update any changes made
      If FileFolderExists(InputPage.MainFolderLocation.Text &amp; "calc_and_trans\ExportModules\EditSpoolSheet.bas") Then 'change path for home
          MoveFromWkb.VBProject.VBComponents("EditSpoolSheet").export InputPage.MainFolderLocation.Text &amp; "calc_and_trans\ExportModules\EditSpoolSheet.bas" 'change path for home
          MoveToWkb.VBProject.VBComponents.Import InputPage.MainFolderLocation.Text &amp; "calc_and_trans\ExportModules\EditSpoolSheet.bas" 'change path for home
  
      Else
          MoveFromSht.Shapes("EditSpoolSheetButton").Visible = msoFalse
          MoveFromSht.Shapes("UpdatePageNumberButton").Visible = msoFalse
          MoveFromSht.Shapes("CancelEditButton").Visible = msoFalse
          MoveFromSht.Shapes("DeletePanelButton").Visible = msoFalse
      End If
  End If
  
  For Each CellName In MoveToWkb.Names
      If Right(CellName.name, 10) &lt;&gt; "Print_Area" Then
          CellName.Delete
      End If
  Next
  
  Dim NewPgNum As String
  Dim OldPgNum As String
  Dim startRead As Integer
  Dim continueRun As Boolean
  continueRun = False
  
  
  NewPgNum = InputPage.Range("PgNum")
  For Each Sht In MoveToWkb.Worksheets
      startRead = InStr(Sht.name, "(Pg")
  
      If Mid(Sht.name, startRead + 3) = (Right(MoveFromSht.name, Len(NewPgNum) + 1)) And DoubleSheet = False Then
          DoubleSheet = True
          Application.ScreenUpdating = True
          SSCopyYesNo = MsgBox("Do you want to overwrite " &amp; Sht.name &amp; "?", vbYesNo + vbQuestion)
          Application.ScreenUpdating = False
  
          If SSCopyYesNo = vbYes Then
              Dim spoolPosition As Integer
              spoolPosition = Sht.Index
              Sht.name = "_"
              'attaching a macro to the edit spool sheet button
              If FileFolderExists(InputPage.MainFolderLocation.Text &amp; "calc_and_trans\ExportModules\EditSpoolSheet.bas") Then 'change path for home
                  MoveFromSht.Shapes("EditSpoolSheetButton").OnAction = "EditSpoolSheetClicked"
                  MoveFromSht.Shapes("UpdatePageNumberButton").OnAction = "UpdatePageNumberClicked"
                  MoveFromSht.Shapes("CancelEditButton").OnAction = "CancelEditButtonClicked"
                  MoveFromSht.Shapes("DeletePanelButton").OnAction = "DeletePanelButtonClicked"
              End If
              MoveFromSht.Range("Page_Number") = MoveFromSht.Range("AK21")
              MoveFromSht.Copy After:=MoveToWkb.Sheets(spoolPosition)
              Application.DisplayAlerts = False
              Sht.Delete
              Application.CutCopyMode = False
              continueRun = True
          End If
  
      ElseIf DoubleSheet &lt;&gt; True Then
          DoubleSheet = False
      End If
      SheetCounter = SheetCounter + 1
  Next
  
  
  
  If DoubleSheet = False Then
      Set PasteSheet = Workbooks(MoveToWkb.name).Worksheets.Add
  '    MoveFromSht.Copy before:=MoveToWkb.Sheets(1)
      'attaching a macro to the edit spool sheet button
      If FileFolderExists(InputPage.MainFolderLocation.Text &amp; "calc_and_trans\ExportModules\EditSpoolSheet.bas") Then 'change path for home
          MoveFromSht.Shapes("EditSpoolSheetButton").OnAction = "EditSpoolSheetClicked"
          MoveFromSht.Shapes("UpdatePageNumberButton").OnAction = "UpdatePageNumberClicked"
          MoveFromSht.Shapes("CancelEditButton").OnAction = "CancelEditButtonClicked"
          MoveFromSht.Shapes("DeletePanelButton").OnAction = "DeletePanelButtonClicked"
      End If
      MoveFromSht.Range("Page_Number") = MoveFromSht.Range("AK21")
      MoveFromSht.Copy After:=MoveToWkb.Sheets(SheetCounter)
      Application.CutCopyMode = False
      continueRun = True
  End If
  
  If continueRun Then
  
      For Each Sht In MoveToWkb.Worksheets
          If Mid(Sht.name, 1, 5) = "Sheet" Then
              Application.DisplayAlerts = False
              Sht.Delete
          End If
      Next
  
  
      Set MoveToSht = MoveToWkb.Sheets(MoveFromSht.name)
  
      Dim moveToShtName As String
      moveToShtName = MoveToSht.name
  
      'fix in here
      For Each CellName In MoveToWkb.Names
          If Right(CellName.name, 10) &lt;&gt; "Print_Area" Then
              Application.DisplayAlerts = False
              CellName.Delete
          End If
      Next
  
      Application.PrintCommunication = False
      MoveToSht.DisplayPageBreaks = False
  
      'For Each Sht In MoveToWkb.Worksheets
          With MoveToSht.PageSetup
  
                  .PrintArea = "$A$1:$Z$36"
                  .Orientation = xlLandscape
                  .PaperSize = xlPaperLetter
                  .BlackAndWhite = True
                  .Zoom = False
                  .FitToPagesWide = 1
                  .FitToPagesTall = 1
                  .LeftMargin = Application.InchesToPoints(1.6)
                  .RightMargin = Application.InchesToPoints(0)
                  .TopMargin = Application.InchesToPoints(0)
                  .BottomMargin = Application.InchesToPoints(0)
                  .HeaderMargin = Application.InchesToPoints(0)
                  .FooterMargin = Application.InchesToPoints(0)
                  .CenterHorizontally = True
                  .CenterVertically = True
  
          End With
  
      Application.PrintCommunication = True
  
  
  
      '%%%%%%%%new crate code %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  
  
      '******************* Update Crate Sheet Info **************************************'
      Dim crateSht As Worksheet
      Dim frontSht As Worksheet
      Set crateSht = MoveToWkb.Sheets("Crate_List")
      Set frontSht = MoveToWkb.Sheets("FrontSheet")
  
      Dim writeRow As Integer
      Dim continueToEnd As Boolean
      Dim roomColumn As Integer, pageColumn As Integer, sizeColumn As Integer, widthColumn As Integer, typeColumn As Integer, tagColumn As Integer
      Dim infoTableCol As Integer
  
      Dim colStep As Integer
      For colStep = 1 To 15
          Select Case crateSht.Cells(1, colStep).Text
              Case "ROOM #"
                  roomColumn = colStep
              Case "PAGE #"
                  pageColumn = colStep
              Case "PANEL SIZE"
                  sizeColumn = colStep
              Case "PANEL WIDTH"
                  widthColumn = colStep
              Case "SQFT"
                  infoTableCol = colStep
              Case "PANEL TYPE"
                  typeColumn = colStep
              Case "PANEL TAG"
                  tagColumn = colStep
          End Select
      Next
  
  
  
      'if first spoolsheet being added, set constant values (job name, job number etc.)
      If MoveToWkb.Sheets.count = 3 Then
          frontSht.Cells(5, 6) = MoveToSht.Range("AK2")
          frontSht.Cells(6, 6) = MoveToSht.Range("AK3")
          Dim EventsState As Boolean
          EventsState = Application.EnableEvents
          Application.EnableEvents = False
          frontSht.Cells(6, 12) = MoveToSht.Range("AK7")
          Application.EnableEvents = EventsState
      End If
  
      'determines where to write panel data: if row is blank, if Page # being written and read are both "" and panel tag/room # match, and if page numbers are not "" and match
      For writeRow = 2 To 500
          If Len(crateSht.Range("A" &amp; writeRow).value) = 0 Or (InputPage.Range("PgNum") = "" And crateSht.Cells(writeRow, pageColumn).value = "" And crateSht.Range("A" &amp; writeRow).value = InputPage.Range("RoomNum").value And _
          crateSht.Cells(writeRow, tagColumn).value = InputPage.Range("PanelTag").value) Or (InputPage.Range("PgNum").value &lt;&gt; "" And _
          InputPage.Range("PgNum").value = crateSht.Cells(writeRow, pageColumn).value) Then
              'If continueToEnd Then
              Exit For
          End If
      Next
  
      Dim panelCrateData(24) As Variant
      Dim panelTableData As Variant
      panelTableData = MoveToSht.Range("AK1:AK39")
  
      'writing spoolsheet information to crate sheet
      With MoveToSht
          If roomColumn &lt;&gt; 0 Then crateSht.Cells(writeRow, roomColumn) = panelTableData(22, 1) '.Range("AK22")
          If pageColumn &lt;&gt; 0 Then crateSht.Cells(writeRow, pageColumn) = panelTableData(21, 1) '.Range("AK21")
          If sizeColumn &lt;&gt; 0 Then crateSht.Cells(writeRow, sizeColumn) = panelTableData(13, 1) '.Range("AK13")
          If widthColumn &lt;&gt; 0 Then crateSht.Cells(writeRow, widthColumn) = panelTableData(12, 1) ' .Range("AK12")
          If tagColumn &lt;&gt; 0 Then crateSht.Cells(writeRow, tagColumn) = panelTableData(24, 1)
          If typeColumn &lt;&gt; 0 Then crateSht.Cells(writeRow, typeColumn) = panelTableData(23, 1)
  
          panelCrateData(0) = Round(CDbl(Replace(.Range("X35").Text, "SQFT", "")), 2)
          panelCrateData(1) = panelTableData(15, 1) '.Range("AK15")
          panelCrateData(2) = panelTableData(14, 1) '.Range("AK14")
          panelCrateData(3) = panelTableData(17, 1) '.Range("AK17")
          panelCrateData(4) = panelTableData(16, 1) '.Range("AK16")
          panelCrateData(5) = panelTableData(18, 1) '.Range("AK18")
          panelCrateData(6) = panelTableData(20, 1) '.Range("AK20")
          panelCrateData(7) = panelTableData(19, 1) '.Range("AK19")
          panelCrateData(8) = panelTableData(25, 1) '.Range("AK23")
          panelCrateData(9) = panelTableData(26, 1) '.Range("AK24")
          panelCrateData(10) = panelTableData(27, 1) '.Range("AK25")
          panelCrateData(11) = panelTableData(29, 1) '.Range("AK27")
          panelCrateData(12) = panelTableData(30, 1) '.Range("AK28")
          panelCrateData(13) = panelTableData(31, 1) '.Range("AK29")
          panelCrateData(14) = panelTableData(28, 1) '.Range("AK26")
          panelCrateData(15) = panelTableData(34, 1) '.Range("AK32")
          panelCrateData(16) = panelTableData(33, 1) '.Range("AK31")
          panelCrateData(17) = panelTableData(35, 1) '.Range("AK33")
          panelCrateData(18) = panelTableData(36, 1) '.Range("AK34")
          panelCrateData(19) = panelTableData(37, 1) '.Range("AK35")
          panelCrateData(20) = panelTableData(38, 1) '.Range("AK36")
          panelCrateData(21) = panelTableData(39, 1) '.Range("AK37")
          panelCrateData(22) = .Range("AU19")
  
          'Holdback Info
          panelCrateData(23) = .Range("AU12")
          panelCrateData(24) = .Range("AU14")
  
          'Additional Saddles
          crateSht.Range(crateSht.Cells(writeRow, infoTableCol), crateSht.Cells(writeRow, infoTableCol + 24)) = panelCrateData ' "M" &amp; writeRow &amp; ":AK" &amp; writeRow) = panelCrateData
  
      End With
  
  
      For writeRow = 2 To 500
          If Len(crateSht.Range("A" &amp; writeRow).value) = 0 Then ' Or crateSht.Range("A" &amp; writeRow).value = InputPage.Range("RoomNum").value Then
              'If continueToEnd Then
              Exit For
          End If
      Next
  
  
      Dim lastRow As Integer
      lastRow = writeRow - 1
  
      Dim totSqft As Double
      totSqft = WorksheetFunction.Sum(crateSht.Range(crateSht.Cells(2, infoTableCol), crateSht.Cells(lastRow, infoTableCol))) '(crateSht 2:M" &amp; lastRow))
  
  
      Application.PrintCommunication = False
      With crateSht
          .PageSetup.PrintArea = "$A$1:$H$" &amp; CStr(lastRow)
          .PageSetup.PrintTitleRows = "$1:$1"
          If lastRow = 2 Then .PageSetup.CenterHeader = "#" &amp; MoveToSht.Range("AK3").value
  
          .PageSetup.RightFooter = CStr(lastRow - 1) &amp; " PANELS" &amp; vbLf &amp; "TOUCH UP KIT" &amp; vbLf &amp; "INTERCONNECTORS" _
                                   &amp; vbLf &amp; "GLOVES" &amp; vbLf &amp; "T-BAR CLIPS" &amp; vbLf &amp; "INSULATION ON PANEL"
  
          .PageSetup.RightHeader = CStr(totSqft) &amp; " SQFT"
  
  
  
  
      End With
      Application.PrintCommunication = True
  
      With frontSht
          .Cells(11, 2) = lastRow - 1
          .Cells(30, 2) = totSqft
      End With
  
  
      MoveToWkb.SaveAs filename:=FileLocation, FileFormat:=50
  
      MoveToWkb.Close False
  
      Set MoveToWkb = Nothing
  
      '**********************************************************************************'
  
      'Add new entry to recent panels table, unless room number already exists then replace that entry with the current info=
      Call AddRecentPanelData
  
      MoveFromSht.Delete
  
      newXL.Application.ScreenUpdating = True
      newXL.Application.DisplayAlerts = True
      newXL.Application.AskToUpdateLinks = True
      Application.Calculation = xlCalculationAutomatic
  
      Set MoveFromWkb = Nothing
      Set MoveFromSht = Nothing
      Set MoveToSht = Nothing
  
  
      newXL.Workbooks.Open FileLocation ', UpdateLinks:=False ', ReadOnly:=False
  
      Set newXL = Nothing
  
  
  
  Else
      MoveToWkb.Close SaveChanges:=False
  
      Set MoveToWkb = Nothing
  
      newXL.Workbooks.Open FileLocation, UpdateLinks:=False, ReadOnly:=False
  
      MoveFromSht.Delete
  
      Application.Calculation = xlCalculationAutomatic
  
      Set newXL = Nothing
      Set MoveFromWkb = Nothing
      Set MoveFromSht = Nothing
      Set MoveToSht = Nothing
  
  End If
  
  Exit Sub
  
  '#########################################################################################
  ErrorHandler:
  
      Dim Msg As String
      If Err.number &lt;&gt; 0 Or Err.number &lt;&gt; 20 Then
       Msg = "Error # " &amp; Str(Err.number) &amp; " was generated by " _
               &amp; Err.Source &amp; Chr(13) &amp; "Error Line: " &amp; Erl &amp; Chr(13) &amp; Err.Description
       MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
      End If
  
      Call ReactiveUpdating
  
  End Sub
  </code></pre>
  
  <p>So Workbook A uses this sub to create Workbook B/Instance B and save worksheets to it.  The problem is, when Workbook A tries to add the 20th worksheet (sometimes 24th or 23rd but consistently in this area) there is an error in opening Workbook B in Instance B on this line (a couple scrolls up from the bottom) causing the code to break:</p>
  
  <pre><code>newXL.Workbooks.Open FileLocation, UpdateLinks:=False, ReadOnly:=False
  </code></pre>
  
  <p><a href="http://i.stack.imgur.com/jRWUk.jpg" rel="nofollow">Method 'Open' of object 'Workbooks' failed</a></p>
  
  <p>If I click continue after this error pops up, it completes without an issue, but Workbook B in Instance B is corrupt. Also, if I click the X to close it Excel crashes, and Workbook B is corrupt/unable to open.</p>
  
  <p>The strange thing is, it will always crash after the same number of worksheets are saved (between 20-23 worksheets).  Even when I tried closing both workbooks and instances down completely after saving 19 times (just before the expected crash), saving the 20th worksheet still caused a crash.</p>
  
  <p>This only started happening about a month ago, and it occurs on all the computers we have tested it on.  We have even tested year old versions of the workbook, that certainly never had this issue, and they all have the same issue.</p>
  
  <p>Please let me know if you can offer any help or need any more detail, any insight is greatly appreciated!</p>