Find a row based on a word in the cell

[mrsviqt]

I would like to search a worksheet for "apple". When it finds "apple", I
want it to select that row, as well as the row below it (which does not
contain the word "apple".) I would like to continue to search until the end
of the worksheet. So, it will find all rows that contain the word "apple",
select that row, as well as the row directly beneath it. Then it needs to
cut these cells and paste into a new worksheet.

The rows will never be the same, but the word "apple" will always occur in
column A. "apple" will never be the first or last word in the cell.

Any help would be greatly appreciated.

 

[JLGWhiz]

This worked pretty good in testing:

Sub getApple()
Dim lr As Long, sh As Worksheet, rng As Range
Dim sh2 As Worksheet, lr2 As Long, c As Range
Set sh = ActiveSheet
Set sh2 = Sheets("Sheet2")
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = sh.Range("A2:A" & lr)
For Each c In rng
lr2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row
If InStr(LCase(c.Value), "apple") > 0 Then
c.Resize(2, 1).EntireRow.Copy sh2.Range("A" & lr2 + 1)
End If
Next
End Sub