Excel VBA: Макрос - копирование-вставка-удаление

[str]

Написал макрос. Цель макроса - проверка колонки с датами. В случае если даты меньше текущей - копирование заданной строки на другой лист и удаление скопированных строк (макрос внизу).

Проблема в том, что корректно работает либо удаление если не использовать копирование:
(Cells(i, 1).Resize(1, j).Copy Destination:=Sheets("Копирование вставка").Cells(i, 2))

Либо корректно работает вставка если не использовать удаление. Но все вместе глючит. В чем может быть причина?

Макрос

Public Sub daty()
   
    Dim lr As Long, i As Long, j As Long
   
    lr = Cells(1000, 1).End(xlUp).Row
   
    For i = 1 To lr
        For j = 1 To 4
            If Cells(i, 2) < Date Then
                Cells(i, 1).Resize(1, j).Copy Destination:=Sheets("Копирование вставка").Cells(i, 2)
                Range(Cells(i, 1), Cells(i, 4)).Delete
            End If
        Next j
    Next i
   
End Sub

[свернуть]

[вложение удалено администратором]

[Администратор]

Ваш файл не соответствует вашему макросу. Макрос смотрит дату в столбце B, а в файле дата находится в столбце A.
Если нужно удалять, то нужно двигаться снизу вверх, иначе переменная i будет переходить не к следующей строке, а будет перескок.

Макрос под ваш файл:

Макрос

Public Sub daty()
   
    Dim lr As Long, i As Long
   
    ' Отключение монитора, чтобы ускорить макрос.
    Application.ScreenUpdating = False
   
    lr = Cells(1000, 1).End(xlUp).Row
   
    For i = lr To 1 Step -1
   
        ' Проверка, что в ячейке есть дата.
        If IsDate(Cells(i, 1)) = False Then
            GoTo metka
        End If
       
        ' Проверка даты.
        If Cells(i, 1) >= Date Then
            GoTo metka
        End If
       
        ' Копирование и удаление.
        Cells(i, 1).Resize(1, 4).Copy Destination:=Sheets("Копирование вставка").Cells(i, 2)
        Range(Cells(i, 1), Cells(i, 4)).Delete

metka:
    Next i
   
    ' Включение монитора и сообщение.
    Application.ScreenUpdating = True
    MsgBox "Готово.", vbInformation
   
End Sub

[свернуть]