Finding the text Dismantle and filling respective row with a color then copy All Dism

Dear All,

I have an interesting problem.
I have an excel sheet with 20000 rows.
Column n contains text "Dismantle".The text "Dismantle" appearing randomly in column n.
I want a formula or macro that check the criterion in column N as "Dismantle" If "Dismantle" text is found in column n
Then Fill a color that row and then copy All "Dismantle" row to a new sheet.
The original sheet remain intact.

PLease Help

Rgds,
Aligahk06

[vba]

Public Sub ProcessTheData()
Dim i As Long
Dim LastRow As Long
Dim NextRow As Long

With Worksheets("Sheet1")

LastRow = .Cells(.Rows.Count, "N").End(xlUp).Row
For i = 1 To LastRow

If .Cells(i, "N").Value2 = "Dismantle" Then

NextRow = NextRow + 1
.Rows(i).Copy Worksheets("Sheet2").Cells(NextRow, "A")
.Rows(i).Interior.ColorIndex = 38
End If
Next i
End With
End Sub
[/vba]