move rows based on cell criteria from sheet to another

[abdelfattah]

hi
i have this code works well i would if is possible to make it copy rows what contains "not available" in one time in my case i have to press every time each row contains "not available " i find this is not practical and take me more time if i have 1000 rows of data

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("F:F")) Is Nothing Then
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
Dim Lastrow As Long
Lastrow = Sheets("RESULT").Cells(Rows.Count, "F").End(xlUp).Row + 1

If Target.Value = "NOT AVAILABLE" Then
Rows(Target.Row).Copy Destination:=Sheets("RESULT").Rows(Lastrow)
Rows(Target.Row).Delete
End If
End If
End Sub

thanks

 

[JLGWhiz]

I changed the sode slightly and it seems to be more reliable. Give this a try.

Sub notAvail()
Dim rng As Range
With Sheets("Data")
    .UsedRange.AutoFilter 6, "Not available"
    Set rng = .UsedRange.SpecialCells(xlCellTypeVisible)
    If Not rng Is Nothing Then
        Sheets("RESULT").UsedRange.ClearContents 'Removes old data from sheet
        rng.Copy Sheets("RESULT").Range("A1")
    End If
    Set rng = .UsedRange.Offset(1).SpecialCells(xlCellTypeVisible)
    rng.EntireRow.Delete
    .AutoFilterMode = False
End With
End Sub

 

[abdelfattah]

for me i prefer your codes in post#2,4 any way thanks for your effort and time
best regards
abdelfattah

 

[abdelfattah]

I changed the sode slightly and it seems to be more reliable. Give this a try.

now it works , great work ! thanks so much

 

[JLGWhiz]

now it works , great work ! thanks so much

You're welcome and thanks for the feedback,
regards, JLG