Search column for string and return every row with that string in new sheet

Hi All,

I want to search column B for "Dog" and return then copy every row with "Dog" in column B to a new sheet. The solution would be to return AB in A1, Red Dog in B1, CD in A2, and Blue Dog in B2. This example is much simpler, but you can see my progress in the code below:

Please help!

Sub search_Click()
Dim strFind As String
Dim NextRow As Long
Dim rngFound As Range
Dim wsSource As Worksheet, wsResult As Worksheet

Set wsSource = Sheets("Sheet1")
Set wsResult = Sheets("Sheet2")

With wsSource
strFind = .Range("C2").Value
Set rngFound = .Range("B1:B15000").Find(What:=strFind, LookAt:=xlPart)
If Not rngFound Is Nothing Then
NextRow = wsResult.Range("B" & Rows.Count).End(xlUp).Row + 1
rngFound.EntireRow.Copy wsResult.Range("A" & NextRow)
End If
End With

End Sub

AB	Red Dog
CD	Blue Dog
EF	Yellow Cat