Макрос выборки по заданной дате и перенос данных в другую книгу

Sub Perenos()
Dim Wb As Workbook, Wo As Workbook, LastRow As Long, I As Long, FIO As String
Dim Ik As Long, Jk As Long, S As String, K As Integer, Dat As Date
Dim dS As Date
Set Wb = ThisWorkbook
Wb.Activate
Sheets(1).Activate
For I = 1 To Workbooks.Count
  If Left(LCase(Workbooks(I).Name), 5) = "отчет" Then
    Set Wo = Workbooks(I)
    Exit For
  End If
Next
'S = "13.09.2017"
S = InputBox("Введите дату в формате дд.мм.гггг")
If S = "" Then Exit Sub
Dat = S
Ik = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1
Wo.Activate
Sheets(1).Activate
Jk = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1
Wb.Activate
'MsgBox Ik & " " & Jk
With Wo.Sheets(1)
For I = 5 To Jk
  dS = Format(.Cells(I, 6), "dd.mm.yyyy")
  If dS >= Dat And LCase(.Cells(I, 9)) = "сдан" Then
    S = Format(dS, "dd.mm.yy")
    FIO = .Cells(I, 3)
    For K = 2 To Ik 'а вдруг уже есть в журнале
      If Cells(K, 8) = S And Cells(K, 2) = FIO Then GoTo OUT
    Next
    Ik = Ik + 1
    With Range("A" & Ik & ":L" & Ik)
      .Borders(xlEdgeLeft).LineStyle = xlContinuous
      .Borders(xlEdgeTop).LineStyle = xlContinuous
      .Borders(xlEdgeBottom).LineStyle = xlContinuous
      .Borders(xlEdgeRight).LineStyle = xlContinuous
      .Borders(xlInsideVertical).LineStyle = xlContinuous
    End With
    Cells(Ik, 1) = IIf(Ik = 2, 1, Cells(Ik - 1, 1) + 1)
    Cells(Ik, 2) = .Cells(I, 3)
    Cells(Ik, 3) = .Cells(I, 5)
    Cells(Ik, 4) = .Cells(I, 4)
    Cells(Ik, 8) = S
  End If
OUT:
Next
End With
End Sub