Макрос переноса данных при пересечении временных диапазонов

[strannick]

Добрый день, уважаемые форумчане!
Есть потребность переносить данные с накопительного листа (Лист1) при условии, если, диапазон дат, выбираемый Пользователем на листе Статистика в ячейках С2 и Е2, пересекается с диапазоном дат в столбцах Е и F на Листе1. Вот я тут накидал код, но он выводит только первого найденного:

Sub Данные()
Application.ScreenUpdating = False
Dim iLastRow1 As Long
Dim sh1 As Worksheet, sh2 As Worksheet


    Set sh1 = Sheets("Лист1")
    Set sh2 = Sheets("Статистика")
    iLastRow1 = sh2.Cells(Rows.Count, 1).End(xlUp).Row
    For k = 2 To 2000
    If sh2.Range("C2").Value >= sh1.Cells(k, 5).Value And sh2.Range("C2").Value < sh1.Cells(k, 6).Value Then
    sh2.Cells(iLastRow1 + 1, 1) = sh1.Cells(k, 3)
    Exit For
    End If
    Next
    
Application.ScreenUpdating = True
End Sub

Это первое. Второе, условие

If sh2.Range("C2").Value >= sh1.Cells(k, 5).Value And sh2.Range("C2").Value < sh1.Cells(k, 6).Value Then

не совсем корректное. Думается надо так:

If sh2.Range("C2").Value >= sh1.Cells(k, 5).Value Or sh2.Range("E2").Value <= sh1.Cells(k, 6).Value Is Nothing Then

Подскажите, как будет правильней и точнее? Файл во вложении.
Пытался формулами вытащить, но при повторении Плательщика находило только первого в списке и подтягивало только его данные.
Заранее спасибо!

[88ra]

    For k = 2 To 2000
        If sh2.Range("C2").Value >= sh1.Cells(k, 5).Value And sh2.Range("E2").Value <= sh1.Cells(k, 6).Value Then
            iLastRow1 = iLastRow1 + 1
            sh2.Cells(iLastRow1, 1) = sh1.Cells(k, 3)
        
        End If
    Next

[strannick]

Конечно же, добавить единичку каждый раз. Спасибо!!!