Вы неправильно квалифицируете свои объекты с листом, который вполне может быть проблемой. Я адаптировал ваш код для правильной квалификации всех объектов, и это также будет намного быстрее, поскольку он будет копировать / вставлять вне цикла только один раз.
Например, скажем, у вас есть 500 строк, которые соответствуют вашим критериям (Range > Date
). Это означает, что у вас будет 500 экземпляров строк, которые копируются и вставляются снова и снова внутри вашего цикла. Метод ниже будет иметь только один экземпляр копирования / вставки и не зависит от того, сколько строк соответствует вашим критериям. Чем больше строк будет скопировано, тем больше вы выиграете от этого решения.
Другое возможное решение - просто отфильтровать по вашим критериям и скопировать / вставить только видимые ячейки
Обновлено для большего количества критериев, добавленных в комментарии - проверено и отлично работает на моем конце
Option Explicit
Private Sub CommandButton21_Click()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim i As Long, MyUnion As Range, LRow As Long
For i = 2 To ws.Range("A" & ws.Rows.Count).End(xlUp).Row
If ws.Range("G" & i) > #10/31/2013# Or ws.Range("AA" & i) = "Investigate" Or ws.Range("AA" & i) = "Leave Open" Then
If Not MyUnion Is Nothing Then
Set MyUnion = Union(MyUnion, ws.Range("G" & i))
Else
Set MyUnion = ws.Range("G" & i)
End If
End If
Next i
If Not MyUnion Is Nothing Then
With ThisWorkbook.Sheets("Sheet2")
LRow = .Range("A" & .Rows.Count).End(xlUp).Offset(1).Row
MyUnion.EntireRow.Copy .Range("A" & LRow)
End With
End If
End Sub
До и после

