Сообщение недостаточно ресурсов

[mephist]

Работает макрос, в процессе работы выдает:

Недостаточно ресурсов! Выберите меньше данных или закройте другие приложения

. Но при этом он все делает, что должен был. Можно избавиться от этого сообщения ибо оно выскакивает 15 раз за время работы макроса.

On Error Resume Next

не работает!

[The_Prist]

Если Вы в макросе используете много переменных(особенно типы: объекты(As Object и т.п.), массивы), то посоветовал бы удалять данные о них из памяти - уничтожать такие переменные после того как они отработали свою здачу:
Object:

Dim oObject as Object
set oObject = Sheets(1)
'отработал
Set oObject = Nothing

Массивы:

Dim avArray as Variant'либо другие типы
ReDim avArray(1000)
'заполнили данными - отработал
Erase avArray

А возможно пытаетесь выполнить операции над слишком большим объемом данных(большой массив) и у Вас не хватает сис.памяти для обработки такого массива полностью. В данном случае Excel пытается сам освободить часть памяти для выполнения процесса.


Это мое мнение. Сейчас может спецы подключаться и посоветуют чего-нибудь более толковое...

[mephist]

Спасибо, толковая идея. Я должен был написать, что в макросе я копирую листы с вложенными Вордовскими файлами. Память после копирования вроде чищу, а он все равно ругается. Сам код:

Sub blank_fill_89()
Dim li As Long, asFileNames
    Application.Calculation = xlCalculationManual: Application.ScreenUpdating = False: Application.CutCopyMode = False: On Error Resume Next
    ActiveWorkbook.RemovePersonalInformation = False:
    asFileName = Array("hq.xlsx", "sz.xlsx", "sd.xlsx", "mk.xlsx", "mp.xlsx", "mc.xlsx", "ug.xlsx", "mn.xlsx", mh.xlsx")
    For li = LBound(asFileName) To UBound(asFileName)
        Filename = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, asFileName(li))
        With Workbooks.Open(Filename, False, , , , , True)
            Dim Sh As Worksheet
            For Each Sh In Sheets
                Sh.Unprotect
                Sh.UsedRange.Value = Sh.UsedRange.Value
            Next
        .Worksheets(14).Cells.Copy ThisWorkbook.Worksheets(li + 1).[a1]
        .RemovePersonalInformation = False
        .Close False
        End With
    Next li
    ThisWorkbook.Save
    Application.Calculation = xlCalculationAutomatic
End Sub