Копирование

[Luda]

подскажите что делаю не так, сравниваю разность двух дат, если удовлетворяет условию, то часть строки копирую на другой лист с последующим удалением из первого листа всей строки, а если значений удовлетворяющих условию несколько, то почему-то берет только первое и вставляет именно в ту же строку что и было на первом листе, а надо в первую незаполненную строку, процедура срабатывает при открытии книги и нужно чтобы все строки удовлетворяющие условию перемещались бы на второй лист, подскажите пожалуйста как сделать.
Public Sub gotovie()
iRowLast = Worksheets("лист1").Cells(65536, 1).End(xlUp).Row
For i = 6 To iRowLast
If (DateDiff("d", Worksheets("лист1").Cells(i, 6).Value, Worksheets("лист1").Cells(4, 2).Value)) >= 0 Then
Set iListone = Worksheets("лист2")
Set iListTwo = Worksheets("лист1")
If iListone.Cells(i, 1).Value = "" Then
iListone.Cells(i, 1).Value = iListTwo.Cells(i, 1).Value
iListone.Cells(i, 2).Value = iListTwo.Cells(i, 2).Value
iListone.Cells(i, 3).Value = iListTwo.Cells(i, 3).Value
iListone.Cells(i, 4).Value = iListTwo.Cells(i, 4).Value
iListone.Cells(i, 5).Value = iListTwo.Cells(i, 5).Value
iListone.Cells(i, 6).Value = iListTwo.Cells(i, 7).Value
iListTwo.Cells(i, 10).Copy
iListone.Select
iListone.Cells(i, 7).PasteSpecial Paste:=xlPasteAll
With Worksheets("лист1")
.EnableSelection = xlNoRestrictions
.Protect Contents:=True
End With
Worksheets("лист1").Unprotect Password:="123"
Worksheets("лист1").Rows(i).Delete
End If
End If
Next
Worksheets("лист1").Protect Password:="123", DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

[mnzol]

Неправильно вставляет - есть ошибки в алгоритме:
cells(i, 10).pastespecial - надо не i а какую-нибудь другую переменную
ну и uprotect не мешало бы вынести перед for

[Luda]

спасибо большое за помощь, при открытии документа все равно копирует только первую запись удовлетворяющую условиям, при повторном открытии - вторую, а все сразу строки переносить почему-то не хочет, не подскажете почему????