ActiveSheet.Paste error

[Robb]

I have a consolidation routine that will, if the user chooses, consolidate the output of all the
sheets in our generated report onto one sheet by appending them one after the other with the
ActiveSheet.Paste method. It has been working fine with no problems until one customer generated a
LOT of reports which means a lot of worksheets in the book and a lot of calls to cut and paste them
all onto one sheet. Through trial and error I found that my machine can handle 90 reports (90
worksheets pasted into one sheet via a loop) before the error occurs. The customer was generating 92
reports (but I do not know at what point the error occurred for him).

The runtime error is:
Method 'Paste' of object '_Worksheet' failed

On a few occasions the same .paste call generated this error first:
No more new fonts may be applied in this workbook.

I'm guessing it is related to available resources somehow but exactly what I have no idea.
Monitoring the system memory shows no increase as the program runs. After 50 or so iterations I do
notice a progressive slowdown beginning.

Here is the code that does the consolidation. The error occurs on the ActiveSheet.Paste call.

Robb
========================================================


Private Sub ConsolidateSheets(SourceWB As Workbook)
'CONSOLIDATES ALL REPORT SHEETS OF PASSED WORKBOOK ONTO ONE SHEET
Dim I As Integer
Dim R As Integer
Dim C As Integer
Dim CurrentRow As Integer
Dim MasterSheet As Worksheet
Dim FoundMasterSheet As Boolean

FoundMasterSheet = False
For I = 1 To SourceWB.Sheets.Count 'LOOP THROUGH ALL SHEETS OF PASSED WORKBOOK
If Right(SourceWB.Sheets(I).Name, 8) = "{Report}" Then 'FIND FIRST REPORT SHEET
If FoundMasterSheet = False Then
FoundMasterSheet = True
Set MasterSheet = SourceWB.Sheets(I)
Set SPC_RS = SourceWB.Sheets(I)
MasterSheet.PageSetup.Zoom = False
MasterSheet.PageSetup.FitToPagesWide = 1
MasterSheet.PageSetup.Zoom = 80
Else 'FIRST REPORT SHEET ALREADY FOUND. NOW COPY TO IT
CurrentRow = GetLastUsedRowCol(MasterSheet, "ROW") + 2 'GET ROW TO COPY TO
R = GetLastUsedRowCol(SourceWB.Sheets(I), "ROW") 'GET RANGE OF CELLS TO COPY
C = GetLastUsedRowCol(SourceWB.Sheets(I), "COL")
SourceWB.Sheets(I).Activate 'SWITCH TO REPORT SHEET TO COPY FROM
SourceWB.Sheets(I).Range(GetRangeString(1, 1, C, R)).Select 'SELECT DATA
Selection.Copy 'COPY DATA
MasterSheet.Activate 'SWITCH TO REPORT SHEET TO COPY TO
MasterSheet.Cells(CurrentRow, 1).Select 'SET LOCATION TO PASTE TO
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell 'SET A PAGE BREAK
ActiveSheet.Paste 'PASTE DATA
End If
End If
Next I

ActiveSheet.PageSetup.FitToPagesWide = 1

On Error Resume Next 'DELETE SHEETS THAT WERE COPIED
Application.DisplayAlerts = False
For I = SourceWB.Sheets.Count To 1 Step -1
If Right(SourceWB.Sheets(I).Name, 8) = "{Report}" Then
If SourceWB.Sheets(I).Name <> MasterSheet.Name Then
SourceWB.Sheets(I).Delete
End If
End If
Next I
Application.DisplayAlerts = True
On Error GoTo 0

MasterSheet.Cells(1, 1).Select 'SELECT CELL A,1 (AESTHETIC REASONS ONLY)

End Sub


Public Function GetLastUsedRowCol(WS As Worksheet, RowOrCol As String) As Variant
'RETURNS THE NUMBER OF THE LAST ROW IN THE SPECIFIED WORKSHEET'S USEDRANGE
Dim CellWasEmpty As Boolean

CellWasEmpty = (WS.Cells(1, 1) = "") 'CELL(1,1) IS EMPTY

If CellWasEmpty Then 'IF CELL IS EMPTY, THEN TEMP FILL IT
WS.Cells(1, 1) = "."
End If

Select Case UCase(RowOrCol)
Case "ROW": GetLastUsedRowCol = WS.UsedRange.Rows.Count
Case "COL": GetLastUsedRowCol = WS.UsedRange.Columns.Count
Case Else: MsgBox "Invalid value [" & RowOrCol & "] passed." & vbCrLf & _
"Module: modTarus" & vbCrLf & _
"Function: GetLastUsedRowCol", vbCritical, "Program Error"
GetLastUsedRowCol = 0
End Select

If CellWasEmpty Then WS.Cells(1, 1).Clear 'IF CELL WAS ORIGINALLY EMPTY, THEN EMPTY IT AGAIN

End Function


========================================================