Hello Steved.

Can you adapt the following to suit your needs?

(Code copied from one of the frequent posters. I think maybe Dave Peterson,
but I'm not sure.)

Private Sub tester()

Application.ScreenUpdating = False
Dim r As Range
With ActiveSheet
..AutoFilterMode = False
Set r = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
'Debug.Print r.Address(external:=True)
If Application.CountIf(r, "No AVL UNIT") = 0 Then Exit Sub
..Columns("A:A").AutoFilter Field:=1, Criteria1:="No AVL UNIT"
Set r = r.SpecialCells(xlCellTypeVisible)
..AutoFilterMode = False
r.EntireRow.Copy Destination:=Worksheets("No AVL").Range("a2")
r.EntireRow.delete
End With
Application.ScreenUpdating = True
End Sub

"Steved" wrote:

Hello from Steved

Please how do I change the bottom to do

1. find "No AVL UNIT" in Column I in Sheet Named "Trip missed"

2 Once found move to Sheet Named "No AVL" and then Delete the Row in Sheet
"Trip missed" which it had come from.

Thankyou

Sub CopyYRows()
Dim curRowNo As Long
Dim lastInsertRowNo As Long
Dim lastRowNo As Long


lastInsertRowNo = Sheets("No AVL").Range("A65536").End(xlUp).Row + 1
curRowNo = 8 'Start row number in Sheet 1
lastRowNo = Sheets("Trip missed").Range("I65536").End(xlUp).Row
While curRowNo <= lastRowNo
With Sheets("Trip missed").Cells(curRowNo, "I")
If Not IsEmpty(.Value) And IsNumeric(.Value) Then
.EntireRow.Copy Destination:= _
Sheets("No AVL").Range("A" & lastInsertRowNo)
.EntireRow.Delete
lastRowNo = lastRowNo - 1
lastInsertRowNo = lastInsertRowNo + 1
Else
curRowNo = curRowNo + 1
End If
End With
Wend
Sheets("No AVL").Activate


End Sub

Hello from Steved

Brilliant and I thankyou.

Can we take the below and copy under the next empty row.

My objective is that I have a date range and would like to keep a rolling
record as for example It copies todays data, then tomorrow it copies under
the next avaliable empty row and so on ie 15-jan-07, 16-jan-07, 17-jan-07 and
so on.
Thankyou


Private Sub tester()

Application.ScreenUpdating = False
Dim r As Range
With ActiveSheet
.AutoFilterMode = False
Set r = .Range(.Range("A2"), .Range("I" & Rows.Count).End(xlUp))
'Debug.Print r.Address(external:=True)
If Application.CountIf(r, "No AVL UNIT") = 0 Then Exit Sub
.Columns("I:I").AutoFilter Field:=1, Criteria1:="No AVL UNIT"
Set r = r.SpecialCells(xlCellTypeVisible)
.AutoFilterMode = False
r.EntireRow.Copy Destination:=Worksheets("No AVL").Range("a2")
r.EntireRow.delete
End With
Application.ScreenUpdating = True
End Sub

"Steved" wrote:

Hello from Steved

Please how do I change the bottom to do

1. find "No AVL UNIT" in Column I in Sheet Named "Trip missed"

2 Once found move to Sheet Named "No AVL" and then Delete the Row in Sheet
"Trip missed" which it had come from.

Thankyou

Sub CopyYRows()
Dim curRowNo As Long
Dim lastInsertRowNo As Long
Dim lastRowNo As Long


lastInsertRowNo = Sheets("No AVL").Range("A65536").End(xlUp).Row + 1
curRowNo = 8 'Start row number in Sheet 1
lastRowNo = Sheets("Trip missed").Range("I65536").End(xlUp).Row
While curRowNo <= lastRowNo
With Sheets("Trip missed").Cells(curRowNo, "I")
If Not IsEmpty(.Value) And IsNumeric(.Value) Then
.EntireRow.Copy Destination:= _
Sheets("No AVL").Range("A" & lastInsertRowNo)
.EntireRow.Delete
lastRowNo = lastRowNo - 1
lastInsertRowNo = lastInsertRowNo + 1
Else
curRowNo = curRowNo + 1
End If
End With
Wend
Sheets("No AVL").Activate


End Sub