Cut rows and paste to another worksheet

Hi Gary,
Thank you for your quick respond. I am so very new to VBA so I am doing something wrong and my code is not working. Now I am stuck on ((Range("A1").Selection.End(xlDown).Select)). For some reason VBA didn't like it.

Thank you for your help.


Sub Macro1()
Sheets("Data Entry Sheet").Select
Range("A3").CurrentRegion.Name = "Filter"
Range("Filter").AutoFilter Field:=38, Criteria1:="Ready"

Range("A2").CurrentRegion.Offset(1, 0).Cut

Sheets("ARCHIVE").Select
Range("A1").Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.PasteSpecial

Sheets("Data Entry Sheet").Select
Selection.Delete Shift:=xlUp
Selection.AutoFilter
End Sub

Hi Gary,

I am still trying to make my macro working. Everything seems to be OK (when I do F8) untill I come to the line "Delete empty rows". It looks like nothing happening at all, I have to restart Excel as program is not responding.

Kiund regards,
Elena

Sub Archive()

'to stop screen flickering
Application.ScreenUpdating = False

'Selecting Sheet
Sheets("Data Entry Sheet").Select
'All rows to filter
Range("A3").CurrentRegion.Name = "Filter"
'Selecting ready to archive rows
Range("Filter").AutoFilter Field:=38, Criteria1:="Ready to Archive"
'Cutting ready to archive rows
Range("A3:AL" & Range("B65536").End(xlUp).Row).Select
Selection.Copy

'Paste to Archive sheet without switching sheets. I used column B as this is always seems to be populated, so will always go to the last record
Sheets("ARCHIVE").Range("B65536").End(xlUp).Offset(1, -1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

'To delete empty rows
Selection.Delete Shift:=xlUp
Selection.AutoFilter

Application.ScreenUpdating = True


End Sub