Talvez algo como:
Sub copytoarchive()
Dim destSht As Worksheet
Selection.Copy
Workbooks.Open ("C:\...\FileToCopyTo.xlsx")
Set destSht = ActiveWorkbook.Worksheets("Sheet3")
destSht.Activate
Range("A1").Select
destSht.Cells(destSht.Rows.Count, 1).End(xlUp).Offset(1).Select
ActiveSheet.Paste
destSht.Parent.Close True
End Sub
Ele copia, abre a planilha de destino, localiza a próxima linha da maneira que você já estava fazendo, depois cola e fecha.