Предотвратить ошибку «Run-time error» 7 «out of memory» в Excel при использовании макроса

Question

Я получаю эту ошибку всякий раз, когда запускаю макрос в файле Excel. Есть ли способ, которым я могу предотвратить это? Мой код ниже. Отладка выделяет следующую строку как проблему:

ActiveSheet.Shapes.SelectAll

Мой макрос:

Private Sub Save()

Dim sh As Worksheet

ActiveWorkbook.Sheets("Report").Copy 'Create new workbook with Sheets("Report"(2)) as only sheet.
Set sh = ActiveWorkbook.Sheets(1) 'Set the new sheet to a variable. New workbook is now active workbook.
sh.Name = sh.Range("B9") & "_" & Format(Date, "mmyyyy") 'Rename the new sheet to B9 value + date.
With sh.UsedRange.Cells
    .Value = .Value 'eliminate all formulas
    .Validation.Delete 'remove all validation
    .FormatConditions.Delete 'remove all conditional formatting
    ActiveSheet.Buttons.Delete
    ActiveSheet.Shapes.SelectAll
    Selection.Delete

    lrow = Range("I" & Rows.Count).End(xlUp).Row 'select rows from bottom up to last containing data in column I
    Rows(lrow + 1 & ":" & Rows.Count).Delete 'delete rows with no data in column I
    Application.ScreenUpdating = False
    .Range("A410:XFD1048576").Delete Shift:=xlUp 'delete all cells outwith report range
    Application.ScreenUpdating = True

    Dim counter
    Dim nameCount

    nameCount = ActiveWorkbook.Names.Count
    counter = nameCount
    Do While counter > 0
    ActiveWorkbook.Names(counter).Delete
    counter = counter - 1
    Loop 'remove named ranges from workbook

End With
ActiveWorkbook.SaveAs "\\Marko\Report\" & sh.Name & ".xlsx" 'Save new workbook using same name as new sheet.
ActiveWorkbook.Close False 'Close the new workbook.
MsgBox ("Export complete. Choose the next ADP in cell B9 and click 'Calculate'.") 'Display message box to inform user that report has been saved.

End Sub

Не уверен, как сделать это более эффективным или предотвратить эту ошибку.