Тот же макрос, один прогон один сбой с «Ошибка времени выполнения» 1004 «Ошибка удаления метода класса Range»

Question

У меня был макрос, который я использовал месяцами без проблем.На этой неделе некоторые макросы с той же кодировкой получали эту ошибку "Ошибка времени выполнения" 1004 "Ошибка удаления метода класса Range"

Вот код макроса, который работает

End Sub

Sub Macro1()
Dim ARange As Range
Dim DRange As Range
Dim ws As Worksheet
Dim wsA As Worksheet
Dim wsB As Worksheet
Dim filename As String

Set ws = Sheets("Data")
Set wsA = Sheets("Sum by Dept")
Set wsB = Sheets("Macro")
Set DRange = Nothing

Application.DisplayAlerts = False
Application.ScreenUpdating = False

For Each ARange In ws.Range("D1:D14000").Rows
    If ARange(1).Value = "Orr" Or ARange(1).Value = "Thomson" Or ARange(1).Value = "Mattson" Or ARange(1).Value = "Powers" Or ARange(1).Value = "Hermkens" Or ARange(1).Value = "Zamora" Or ARange(1).Value = "Fout" Or ARange(1).Value = "Licka" Or ARange(1).Value = "Fleming" Then
        If DRange Is Nothing Then
            Set DRange = ARange
        Else
            Set DRange = Union(DRange, ARange)
        End If
    End If
Next ARange

If Not DRange Is Nothing Then DRange.EntireRow.Delete

wsA.PivotTables("MasterPivot").PivotCache.Refresh

Application.DisplayAlerts = True
Application.ScreenUpdating = True

filename = wsB.Range("A3") & " " & wsB.Range("B3") & " " & wsB.Range("C3") & " " & wsB.Range("D14")

wsB.Visible = xlSheetHidden
wsA.Activate
ws.Sort.SortFields.Clear
ActiveWorkbook.SaveAs ("Z:\2019\02FEB\First Pass\" & filename & ".xlsm")

Workbooks.Close

Вот тот, который терпит неудачу

End Sub

Sub Macro2()
Dim ARange As Range
Dim DRange As Range
Dim ws As Worksheet
Dim wsA As Worksheet
Dim wsB As Worksheet
Dim filename As String

Set ws = Sheets("Data")
Set wsA = Sheets("Sum by Dept")
Set wsB = Sheets("Macro")
Set DRange = Nothing

Application.DisplayAlerts = False
Application.ScreenUpdating = False

For Each ARange In ws.Range("D1:D14000").Rows
    If ARange(1).Value = "Orr" Or ARange(1).Value = "Thomson" Or ARange(1).Value = "Mattson" Or ARange(1).Value = "Powers" Or ARange(1).Value = "Hermkens" Or ARange(1).Value = "Zamora" Or ARange(1).Value = "Fout" Or ARange(1).Value = "Licka" Or ARange(1).Value = "Fleming" Then
        If DRange Is Nothing Then
            Set DRange = ARange
        Else
            Set DRange = Union(DRange, ARange)
        End If
    End If
Next ARange

If Not DRange Is Nothing Then DRange.EntireRow.Delete

wsA.PivotTables("MasterPivot").PivotCache.Refresh

Application.DisplayAlerts = True
Application.ScreenUpdating = True

filename = wsB.Range("A3") & " " & wsB.Range("B3") & " " & wsB.Range("C3") & " " & wsB.Range("D15")

wsB.Visible = xlSheetHidden
wsA.Activate
ws.Sort.SortFields.Clear
ActiveWorkbook.SaveAs ("Z:\2019\02FEB\First Pass\" & filename & ".xlsm")

Workbooks.Close

Он терпит неудачу здесь в этой части DRange.EntireRow. Удалите во втором макросе, я не вижу, почему это получило бы эту ошибку, поскольку кодто же самое для них обоих