перемещение данных с условием

Всем привет, подскажите подскажите, что нужно изменить, что бы на листе "1111" выделялась строка, в которой в ячейке "J" значение меньше, чем например "01.01.1991" и копировалась на лист "USSR"? При этом на что бы на листе "USSR" были только уникальные значение и они же оставались и на "1111".

Sub updateList()
'переменные и их данные
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim j As Long

   'Ссылки на листы

   Set sourceSheet = ActiveWorkbook.Worksheets("1111")
   Set targetSheet = ActiveWorkbook.Worksheets("USSR")
   
   'Поиск последней строки в столбце A на листе 1111
   lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row
   
   'Копируем данные без заголовков и пустых строк на лист USSR
    j = targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Row + 1
    For i = 2 To lastRow
        If Not IsEmpty(sourceSheet.Cells(i, 1)) Then
            sourceSheet.Range("A" & i & ":AD" & i).Copy targetSheet.Range("A" & j)
                j = j + 1
        End If
    Next i
End Sub

Ответы (0 шт):