Moving cells to last row without erasing over existing - excel

Question

The following code checks to see if any of my rows on the main page contain a date from a year ago or older. If it does, it copies it to the "Archive" worksheet and deletes it from the main page. However, what it's doing now is just copying from the main page and overriding what already exists on the archive page instead of adding to the last row. I've tried subbing in LastRow from a function, but I was getting an error with how I was using it. Anyone have a better solution?
Sub TestDateTransfer()
With Application
PrevCalc = .Calculation
.Calculation = xlCalculationManual
.Cursor = xlWait
.Calculate
.EnableEvents = False
.ScreenUpdating = False
End With
Application.DisplayAlerts = False
Worksheets("Archive").Activate
Range("A3:I1000").Select
Selection.ClearContents
Worksheets("Main Page").Activate
Dim MyDate As Date
MyDate = "03/27/2017"
Set i = Sheets("Main Page")
Set E = Sheets("Archive")
Dim d
Dim j
d = 2
j = 2
Do Until IsEmpty(i.Range("C" & j))
If i.Range("C" & j) <= MyDate - 365 Then
d = d + 1
E.rows(d).Value = i.rows(j).Value
End If
j = j + 1
Loop
Worksheets("Archive").Activate
ActiveSheet.Range("H1").Select 'To unselect the page
Worksheets("Main Page").Activate
MyDate = "03/27/2017"
Dim y
Dim z
y = 2
z = 2
Do Until IsEmpty(i.Range("C" & z))
If i.Range("C" & z) <= MyDate - 365 Then
y = y + 1
i.rows(z).Delete
End If
z = z + 1
Loop
With Application
.Cursor = xlDefault
.Calculate
.Calculation = PrevCalc
'.ScreenUpdating = True 'Not Needed...
.EnableEvents = True
End With
ActiveSheet.Range("H1").Select
End Sub

Answer 1

Worksheets("Archive").Cells(Sheet1.Rows.Count, 1).End(xlUp).Offset(1, 0).Value = "hai"
I have written a small piece of code that shows you how to use this. My code is different than yours b/c it loops through the range and checks each cell if the value of the difference between it and NOW is greater than or equal to 1 (which is how to tell if its from lats year or not). Its not how you approach it but it does seem to be more simplified in the approach. Alsoe I soted a bucnh of dates in a spreadsheet and tested this out. just apply to your needs. I hope this helps more?
Private Sub this()
Dim rng As Range
Dim rcell As Range
Set rng = ThisWorkbook.Sheets("Sheet1").Range("A1:A20")
For Each rcell In rng.Cells
'note that if you dont put a handler in here to deal with blank cells values this code will run forever. most peop-le do a check with "if rcell.valeu <> vbNullString then etc etc
If DateDiff("yyyy", rcell.Value, Now()) >= 1 Then
Worksheets("Sheet2").Cells(Sheet2.Rows.Count, 1).End(xlUp).Offset(1, 0).Value = rcell.Value
rcell.Value = vbNullString
End If
Next rcell
End Sub

Answer 2

You could exploit AutoFilter() method of Range object and copy/paste filtered rows in one shot:
Option Explicit
Sub main()
Dim MyDate As Date
MyDate = "03/27/2017"
Dim E As Worksheet
Set E = Worksheets("Archive")
With Worksheets("Main Page")
With .Range("C1", .Cells(.Rows.Count, "C").End(xlUp))
.AutoFilter field:=1, Criteria1:="<=" & CDbl((MyDate - 365))
If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then Intersect(.Parent.UsedRange, .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).EntireRow).Copy Destination:=E.Cells(Rows.Count, 1).End(xlUp).Offset(1)
End With
.AutoFilterMode = False
End With
End Sub