Error 1004 after copying 84th worksheet to a new workbook...

[MikeZz]

Hi,
I've got a workbook which has a template sheet (shtCopy) and macros in it.
The macro scans data from many files and creates a 1-pager summary on each
file using the template (shtCopy) .

It puts all the 1-pagers into a single new workbook (wbFinal)

Everything seems to work fine until it gets to file/sheet #84.

Then the macro crashes at the following point giving error 1004.
shtCopy.Copy after:=wbFinal.Sheets(1)

Excel says the number of worksheets and named ranges are only limited by
memory of which I have plenty. The filesize up to this point is only about
3MB so it's really not that big.

Any ideas why I could be getting this problem?
I routinely deal with excel files well over 30 Meg so this is very odd.


Thanks for any idea,
MikeZz

Here's the routine that actually causes the error:

Private Sub Create_Contract_Summary(f)
'shtCopy
Dim DefSheets

If workbookCreated = False And CreateNewWB = True Then
workbookCreated = True
Workbooks.Add
DefSheets = ActiveWorkbook.Sheets.Count
Set wbFinal = ActiveWorkbook

Application.DisplayAlerts = False
Do While ActiveWorkbook.Sheets.Count > 1
ActiveSheet.Delete
Loop
Application.DisplayAlerts = True
Set shtSummary = ActiveSheet
shtSummary.Name = "Summary"
ElseIf f = 1 And CreateNewWB = False Then
Set wbFinal = ThisWorkbook
End If

shtCopy.Copy after:=wbFinal.Sheets(1)
Set shtPaste = ActiveSheet

End Sub

 

[RyanH]

It's not really clear what all your variables mean in the code you posted.
Is there any additional code that gives the result of those variables? I
figured it would be a memory issue, because you say it runs smoothly for all
other worksheets added.

 

[MikeZz]

I found the answer to my problems here (memory issues):
http://support.microsoft.com/default.aspx?scid=kb;en-us;210684&Product=xlw

I modified the suggested fix to just do the save once I had a 1004 error and
it works like a charm.

I'll have to modify it a little to make sure that it only does this after a
previous successful sheet copy but that's no big deal.

This is more efficient than the Microsoft version to autosave every XXX
copies. It will only save when it needs to.

Thanks for the help.


Here's the routine as it stands.

Private Sub Create_Contract_Summary(f)
'shtCopy
Dim DefSheets
Dim TrySaveReopen
Dim oBook As Workbook
Dim errmess
Dim shtSumName

On Error GoTo errHandlerMemory

TrySaveReopen = False
If workbookCreated = False And CreateNewWB = True Then
workbookCreated = True
Workbooks.Add
DefSheets = ActiveWorkbook.Sheets.Count
Set wbFinal = ActiveWorkbook

Application.DisplayAlerts = False
Do While ActiveWorkbook.Sheets.Count > 1
ActiveSheet.Delete
Loop
Application.DisplayAlerts = True
Set shtSummary = ActiveSheet
shtSummary.Name = "Summary"
ElseIf f = 1 And CreateNewWB = False Then
Set wbFinal = ThisWorkbook
End If

TrySaveReopen = True
'Added to overcome Memory Error copying to many sheets to a new workbook.
'http://support.microsoft.com/default.aspx?scid=kb;en-us;210684&Product=xlw
shtCopy.Copy after:=wbFinal.Sheets(1)
TrySaveReopen = False

Set shtPaste = ActiveSheet

Exit Sub

errHandlerMemory:
If Err.Number = 1004 And TrySaveReopen = True Then
'Added to overcome Memory Error copying to many sheets to a new workbook.
'http://support.microsoft.com/default.aspx?scid=kb;en-us;210684&Product=xlw
' fileLocAuto = Control.Range("fileLocAuto") 'AutoSaveFile
shtSumName = shtSummary.Name
wbFinal.SaveAs fileName:=fileLocAuto & AutoSaveFile
wbFinal.Close SaveChanges:=False
Set wbFinal = Nothing
Set wbFinal = Application.Workbooks.Open(fileLocAuto &
AutoSaveFile)
shtCopy.Copy after:=wbFinal.Sheets(1)
Set shtSummary = wbFinal.Sheets(shtSumName)
Else
errmess = MsgBox(Err.Number & " " & Err.Description, vbOKOnly)

End If


Resume Next


End Sub