Dim t(), lastrow As Long, i As Long
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
ReDim t(lastrow)
For i = 2 To lastrow
If DateDiff("d", Cells(i, 1), Now) > 720 Then
t(i) = Cells(i, 6)
End If
Next i
For i = 2 To lasrow
Cells(i, 18) = t(i)
Next i
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "not issued last 2 years"
Worksheets("not issued last 2 years").Activate
For i = 2 To lasrow
Cells(i, 1) = t(i)
Next i