WholeRow.Insert Вызывает «Сбой метода вставки класса диапазона» с исключением «Недостаточно памяти»

Question

Предполагается, что приведенный ниже макрос открывает файл данных, находит количество строк данных, а затем вставляет столько строк в рабочую таблицу, прежде чем копировать строки данных и вставлять их. Он будет работать нормально примерно для трех экземпляров. и затем в третий, четвертый или иногда восьмой или десятый (это не согласованно) раз я получаю сообщение об ошибке «Недостаточно памяти», которое непосредственно переходит к получению «Ошибка вставки класса диапазона метода» в строке кода:

С ws .Range ("A" & startrow & ": A" & startrow + lastRow - 2) .EntireRow.Insert

Может кто-нибудь помочь мне понять, как что-то, что прекрасно работает несколько раз вдруг перестает работать? Почему ошибки памяти возникают только в определенных точках? Как я могу избежать их полностью? Что я делаю неправильно? Когда я сохраняю файл между ними, иногда это помогает с памятью, иногда нет. Я чувствую, что схожу с ума здесь. К сведению, я использую Office 365 ProPlus на ноутбуке Dell с 64-разрядной оперативной памятью 8 ГБ. Мой код ниже:

Sub getdata()

    Dim wb As Workbook
    Dim wbOA As Workbook
    Dim ws As Worksheet, wsOA As Worksheet
    Dim OA As FileDialog
    Dim fileName As String
    Dim lastRow As Long
    Dim openName As String
    Dim cell As Range, data As Range, namedRng As Range
    Dim lastCol As Integer

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Set wb = ThisWorkbook
    Set ws = ThisWorkbook.ActiveSheet

    For Each cell In ws.Range("A14:A1000")
        If cell.Value = "APPROVAL -" Then
            startrow = cell.Offset(-1, 0).Row
            Exit For
        End If
    Next cell

    Set OA = Application.FileDialog(msoFileDialogFilePicker)
    OA.AllowMultiSelect = False

    If OA.Show = True Then
        If OA.SelectedItems(1) <> vbNullString Then
            fileName = OA.SelectedItems(1)
        End If
    Else
        End
    End If

    Set wbOA = Workbooks.Open(fileName, , , , , , , , , , , , , True)

    Set wsOA = wbOA.Sheets(1)

    lastRow = Cells(Rows.Count, 1).End(xlUp).Row

    With ws
        **.Range("A" & startrow & ":A" & startrow + lastRow - 2).EntireRow.Insert**
        wb.Sheets("control").Range("A17").EntireRow.Copy
        .Range("A" & startrow & ":A" & startrow + lastRow - 2).PasteSpecial xlPasteAll
        .Activate
        .Range("A" & startrow).Select
    End With

    Application.CutCopyMode = False

    ws.Activate
    ws.Range("A" & startrow).Select

    lastCol = wsOA.Range("A1").End(xlToRight).Column

    wsOA.Activate

    Set data = wsOA.Range(Cells(1, 1), Cells(1, lastCol))

    For Each cell In data
        If cell.Value = "Document" Then
            activecol = cell.Column
            wsOA.Range(Cells(lastRow, activecol), Cells(2, activecol)).Copy
            ws.Range("A" & startrow).PasteSpecial xlPasteValues
        ElseIf cell.Value = "Doc Date" Then
            activecol = cell.Column
            wsOA.Range(Cells(lastRow, activecol), Cells(2, activecol)).NumberFormat = "General"
            wsOA.Range(Cells(lastRow, activecol), Cells(2, activecol)).Copy
            ws.Range("B" & startrow).PasteSpecial xlPasteValues
        ElseIf cell.Value = "Cost Code" Then
            activecol = cell.Column
            wsOA.Range(Cells(lastRow, activecol), Cells(2, activecol)).Copy
            ws.Range("C" & startrow).PasteSpecial xlPasteValues
        ElseIf cell.Value = "Source Reference" Then
            activecol = cell.Column
            wsOA.Range(Cells(lastRow, activecol), Cells(2, activecol)).Copy
            ws.Range("D" & startrow).PasteSpecial xlPasteValues
        ElseIf cell.Value = "Description" Then
            activecol = cell.Column
            wsOA.Range(Cells(lastRow, activecol), Cells(2, activecol)).Copy
            ws.Range("E" & startrow).PasteSpecial xlPasteValues
        ElseIf cell.Value = "Original" Or cell.Value = "Value" Then
            activecol = cell.Column
            wsOA.Range(Cells(lastRow, activecol), Cells(2, activecol)).Copy
            ws.Range("F" & startrow).PasteSpecial xlPasteValues
        End If
    Next cell

    wbOA.Close False

    With Range("J" & startrow & ":J" & startrow + lastRow - 2).Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=$N$3:$N$6"
        .IgnoreBlank = True
        .InCellDropdown = True
        .ShowInput = False
        .ShowError = False
    End With

    With Range("K" & startrow & ":K" & startrow + lastRow - 2).Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=$N$8:$N$12"
        .IgnoreBlank = True
        .InCellDropdown = True
        .ShowInput = False
        .ShowError = False
    End With

    Run "removerows"

    ws.AutoFilter.Sort.SortFields.Clear
    ws.AutoFilter.Sort.SortFields.Add Key:=Range("$M$13"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ws.AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    lastRow = Cells(Rows.Count, 13).End(xlUp).Row

    For Each cell In Range("$M$14:M" & lastRow)
        If cell.Value = cell.Offset(1, 0).Value Then
            cell.Interior.Color = RGB(155, 194, 230)
            cell.Offset(1, 0).Interior.Color = RGB(155, 194, 230)
        End If
    Next cell

    ws.Names("DateCol").RefersTo = ws.Range("B14:B" & lastRow)
    ws.Names("AmountCol").RefersTo = ws.Range("F14:F" & lastRow)
    ws.Names("ClerkCol").RefersTo = ws.Range("G14:G" & lastRow)
    ws.Names("CategoryCol").RefersTo = ws.Range("J14:J" & lastRow)
    ws.Names("BACSCol").RefersTo = ws.Range("K14:K" & lastRow)

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub