Excel 2003 memory issue ?!? arghh!

[samilynn]

I get the following message when I try to run the VB code listed below, which used to work flawlessly with Excel 200.
"Excel cannot complete this task with available resources. Choose less data or close other applications.".
The workbooks aren't that large, but they do contain graphics.
Can you help?
Thanks.

(the code is:


Option Explicit

Dim rngData As Range

Sub ReadWorkbooks()

Const strDirectory As String = "C:\Documents and Settings\MarcD\Desktop\mg"
Dim varFile As Variant

Set rngData = ThisWorkbook.Worksheets("Data").Range("A" & _
ThisWorkbook.Worksheets("Data").Range("A65536").End(xlUp).Row).Offset(1, 0)

Application.ScreenUpdating = False
With Application.FileSearch
.NewSearch
.LookIn = strDirectory
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
If .Execute > 0 Then
For Each varFile In .FoundFiles
Merge varFile
Next
End If
End With
Application.ScreenUpdating = True

End Sub

Sub Merge(ByVal strFileName As String)

Dim lngEndRow As Long, lngRow As Long
Dim ws As Worksheet, shp As Shape

Workbooks.Open strFileName

For Each ws In ActiveWorkbook.Worksheets

ws.Rows(1).Insert
ws.Columns("M").Insert

lngEndRow = ws.Range("A65536").End(xlUp).Row
ws.Range("M2:M" & lngEndRow).FormulaR1C1 = "=CountA(RC1:RC[-1])"
ws.Range("A1:M" & lngEndRow).AutoFilter Field:=13, Criteria1:="<>0"

ws.Range("A2:L" & lngEndRow).SpecialCells(xlCellTypeVisible).Copy
rngData.PasteSpecial xlPasteValues

For Each shp In ActiveSheet.Shapes
shp.Delete
Next shp

Set rngData = ThisWorkbook.Worksheets("Data").Range("A" & _
ThisWorkbook.Worksheets("Data").Range("A65536").End(xlUp).Row).Offset(1, 0)
Next ws
Application.DisplayAlerts = False
ActiveWorkbook.Close SaveChanges:=False
Application.DisplayAlerts = True

End Sub