Сравнение дат с сегодняшней, копирование и перенос данных

Sub Сравнение_Дат()
Application.DisplayAlerts = False
I = 2
k = 2
LastRow1 = Cells(Rows.Count, 3).End(xlUp).Row
Sheets("График").Select
Sheets("Задержка").Range(Cells(I, 1), Cells(I + 21, 4)).ClearContents
 
Sheets("График").Select
Do While Cells(I, 2) <> ""
 
For J = 2 To LastRow1
 
    If Date > Cells(I, 4) Then
    Sheets("График выдачи РД").Range(Cells(I, 1), Cells(I, 3)).Copy
    Sheets("Задержка").Select
    Range(Cells(J, 1), Cells(J, 3)).Select 'выделяем в данной вкладке пустой диапазон, который нашел макрос.
    ActiveSheet.Paste 'вставляем скопированный текст
    Application.CutCopyMode = False 'убрать выделение скопированной ячейки
    End If
I = I + 1
J = J + 1
Next J
 
Application.CutCopyMode = False
    
Loop
 
Application.DisplayAlerts = True
 
End Sub

Private Sub Test()
    Dim ws1 As Worksheet, ws2 As Worksheet, dt As Date, rw1&, rw2&, a
    Set ws1 = Worksheets("График")
    Set ws2 = Worksheets("Задержка")
    
    dt = Date: rw2 = 2: ws2.UsedRange.Clear: ws1.Rows(1).Copy ws2.Rows(1)
    a = ws1.Range("D1", ws1.Cells(ws1.Rows.Count, "D").End(xlUp)).Value
        
    For rw1 = 2 To UBound(a)
        If a(rw1, 1) < dt Then
           ws1.Rows(rw1).Copy ws2.Rows(rw2): rw2 = rw2 + 1
        End If
    Next
End Sub