Sub MoveDate()
Dim rng as Range, rng1 as Range
Application.Goto Reference:="Taken_By"
set rng = Range(ActiveCell,activecell.End(xldown))
set rng1 = range("MovedTo")
if rng1.offset(1,0) = "" then
set rng1 = rng1(1)
else
set rng1 = rng1.end(down)(1)
End if
if application.CountA(rng) = rng.count then
rng.Entirerow.copy Destination:= rng1.entireRow
rng.Entirerow.Delete
End if
End sub

--
Regards,
Tom Ogilvy



"excelnut1954" wrote:

The macro below looks for an entry in a column (Taken By) in each line
of a list in the sheet Official List. If there is something there, it
moves that record to the sheet Deleted List, then comes back and
deletes the original line. It's suppose to go down a line, and
perform the same macro until it recognizes that there are no more
records. It seems to work except that I can't get it to move to the
next row down before looping back. I've tried inserting
ActiveCell.Offset(1, 0).Select
in various places, with no success. I get errors on that line where
ever I put it.
Is my Do statement wrong?
Any help would be appreciated.
Thanks,
J.O.

Sub MoveRecords()

Worksheets("Official List").Activate
Application.Goto Reference:="Taken_By"

Do Until IsEmpty(ActiveCell.Row)
'ActiveCell.Offset(1, 0).Select

'If there is a value in cell, then cut record
If ActiveCell.Value < "" Then
Rows(ActiveCell.Row).Select
Selection.Cut

'Goes to Deleted List to paste record
Worksheets("Deleted List").Activate
Application.Goto Reference:="Moved_To"
ActiveCell.Offset(0, 1).Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, -1).Select
ActiveSheet.Paste

' Goes back to Official List to delete the empty row.
Worksheets("Official List").Activate
Rows(ActiveCell.Row).Delete

'ActiveCell.Offset(1, 0).Select

End If

'ActiveCell.Offset(1, 0).Select

Loop

End Sub