Excel VBA Макросы: Копирование строки с одного листа на другой по дате.

[Iiifobosiii]

Задача. Нужно найти разницу между датой из ячейки C1 и датой из столбца D и если разница больше чем 10 дней, то данную строку скопировать на Лист 1.
Например, в C1 дата 08.01.2020, в столбце D дата 12.12.2019. Между ними разница 27 дней, то есть больше 10, значит данную строку берем и копируем на Лист1.

Сделал макрос, но он работает на половину:

Макрос

Sub qq()
Dim LastRow As Long, Rw As Long

LastRow = Cells(Rows.Count, 4).End(xlUp).Row
    With Sheets("Лист1")
        Rw = .Cells(Rows.Count, 1).End(xlUp).Row + 1
        For i = 6 To LastRow
        If Cells(i, 4) = "02.12.2019" Then
                Range(Cells(i, 2), Cells(i, 6)).Copy .Cells(Rw, 1)
               Rw = Rw + 1
            End If
        Next
    End With
End Sub

[свернуть]

Я подумал, что можно сделать так, но почему-то не работает:
If  (Cells (1,3)-Cells(i,4) )>10 then
Range(Cells(i, 2), Cells(i, 6)).Copy .Cells(Rw, 1)
Rw = Rw + 1
End If

И еще нужно добавить, чтобы данный макрос работал с Листа 1. А то сейчас данный макрос работает только с Листа 2.

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

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

Я подставил в макрос вашу идею. На первый взгляд работает:

Макрос

Sub Макрос()

    Dim sh_src As Worksheet, lr_src As Long
    Dim sh_res As Worksheet, r_res As Long
    Dim i As Long
   
   
    ' Отключаем монитор, чтобы ускорить макрос.
        ' Если много формул, можно ещё отключить формулы.
    Application.ScreenUpdating = False
   
    '1. Присваиваем листам имена. Далее в коде будем обращаться к листам по этим именам.
    Set sh_src = Worksheets("Лист2")
    Set sh_res = ActiveSheet
   
    '2. Поиск последних строк.
        ' End не ищет в скрытых строках.
    lr_src = sh_src.Cells(sh_src.Rows.Count, "D").End(xlUp).Row
    r_res = sh_res.Cells(sh_res.Rows.Count, "A").End(xlUp).Row
   
    '3. Поиск и копирование строк.
    For i = 6 To lr_src
        If (sh_src.Range("C1").Value - sh_src.Cells(i, "D").Value) > 10 Then
            r_res = r_res + 1
            sh_src.Range(sh_src.Cells(i, 2), sh_src.Cells(i, 6)).Copy sh_res.Cells(r_res, 1)
        End If
    Next i
   
    '4. Включение монитора и сообщение.
    Application.ScreenUpdating = True
    MsgBox "Готово.", vbInformation
   
End Sub

[свернуть]

[Iiifobosiii]

Странно Ваш код работает, а мой нет. Я же проверял.
Очень огромное спасибо, всё работает.