Copy an entire row from one sheet to another based upon a single word, within a paragraph, inside a cell

I'm looking to copy a row from one sheet to another based upon having a specific word in the cell. I have a sheet one, called "data" and a sheet two called "final".

Here is an example of the data

A         B            C               D  
jo开发者_C百科hn      mary         555.555.4939    initial reply to phone conversation  
Jim       jack         555.555.5555    floor estimate for bathroom  
jerry     kim          555.555.5553    initial response to phone call

I'd like to copy the entire row from sheet "data" to a sheet "final" if the data in column D contains either the word "reply" or the word "response".

This should work

Sub Foo()

Dim i As Long, iMatches As Long
Dim aTokens() As String: aTokens = Split("reply,response", ",")

For Each cell In Sheets("data").Range("D:D")

    If (Len(cell.Value) = 0) Then Exit For

    For i = 0 To UBound(aTokens)
        If InStr(1, cell.Value, aTokens(i), vbTextCompare) Then
            iMatches = (iMatches + 1)
            Sheets("data").Rows(cell.Row).Copy Sheets("final").Rows(iMatches)
        End If
    Next

Next

End Sub