VBA loop will not copy new workbook after about 100 times.

[igrep4fun]

What I need to do is to track a lot of data over 740 differen
categories then divide each category into about 200 sub categories.
created a macro that will create a new workbook and per category an
then will create a different worksheet for each sub-categories b
looping itself then changing the name by 1. Everything works fine unti
it has created about 100 - 120 worksheets. At that point I get an erro
in my VB script with the copy command. I try to copy a sheet manuall
and it does not work. Here is the KICKER. If I save and close Exce
then reopen it again, I can start to copy again where it left off wit
no problem until my macro has created about another 100 - 120 mor
worksheets. As you can see this is a lot of data and each of the 74
workbooks are about 20 Megs in itself. I could sit in front of it al
day and hitting save and close then reopen it again and re-run m
macro, but the macro takes about 5 minutes to create just 100 sheets.
much just run it on a system over the weekend and come in on Monda
with it all done.

Just A side note... I first thought it was my system untill I tried i
on 10 others with the same results. Some are P1 and some are P4'

 

[Frank Kabel]

Hi
best you post your code which creates theses sheets. Otherwise it's
just guessing in the dark
- garbage collector fault
- to many open objects -> maybe manually re-setting objects to nothing
- or a workaround 8kludgy as it is): Do the saving, closing of Excel
and opening the file again in your macro after 50/80 sheets

 

[Ron de Bruin]

What Excel version?

 

[igrep4fun]

I am using Excel 2000.
Here is the code that I am using that is causing the problem.

Let me explain some names first...

Sheet "Data" is where I have all of my information and new data.
I named and numbered all of my sheets so the macro could easly find i
with a Vlookup. 1 = First Sheet, 759 = Last Sheet.
The # is in J1 and the results go to cell "A1", Cell J3 = J1+1

I also have a "SheetExists" function that checks for the sheetname
That is used in cell K1.

Sheet "New" is my Template that I use with all of the correct settings
Yes I know that is the worst name I could have chosen but it works fo
me.

Sheet "Master" just has Hyperlinks to all of the other sheets.




Sub BuildDes()
'
' BuildDes Macro
' Macro recorded 12/3/2003 by DMN
'

'

Sheets("Data").Select
Start:
If (Range("J1").Value) < 760 Then

Sheets("Data").Select
If Range("K1").Value = False Then
'
'
' Copy sheet "NEW"
'

Sheets("New").Select
Sheets("New").Copy After:=Sheets(6)
Sheets("New (2)").Select
Sheets("Data").Select
Range("J1:J2").Select
Selection.Copy
Sheets("New (2)").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone
SkipBlanks:= _
False, Transpose:=False

Range("A22").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Selection.merge


' Rename the "New" sheet

Sheets("New (2)").Name = Range("A1").Value
Sheets("Data").Select

'
'
' Link the Renamed "New Sheet" to the Master Sheet
'

Sheets("Master").Select
Range(Range("A1").Value).Select
Application.CutCopyMode = False
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=""
SubAddress:= _
(Range(Range("B1").Value).Value)
TextToDisplay:=Range(Range("A1").Value).Value

'
' Change the Value in "DATA" to the next highest #
'
Sheets("Data").Select
Range("J3").Select
Application.CutCopyMode = False
Selection.Copy
Range("J1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone
SkipBlanks:= _
False, Transpose:=False
'
' If sheet is already created then change the Value in "DATA" t
the next highest #
'
Else
Range("J3").Select
Application.CutCopyMode = False
Selection.Copy
Range("J1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone
SkipBlanks:= _
False, Transpose:=False
End If
'
' Start over again from the top
'

GoTo Start
Else
' If all sheets have been created

MsgBox "All Done, Lets do this again next week!!!!"
End If
End Sub





Function SheetExists(SheetName As String) As Boolean
' returns TRUE if the sheet exists in the active workbook
SheetExists = False
On Error GoTo NoSuchSheet
If Len(Sheets(SheetName).Name) > 0 Then
SheetExists = True
Exit Function
End If
NoSuchSheet:


End Functio