Find Locate Cell And Copy 1 Row Below

I have a spreadsheet formed from a text file.

I want to search for each instance of "DOG" in column A, and copy the row below it and then paste that entire row to a new sheet called DOG. I can then autofilter and use a pivot table on the DOG sheet.

I cant just use an autofilter, because the row below can and sometimes does appear elsewhere in the spreadsheet, but refers to something else. It is all because this is an imported text file.

I have attached the spreadsheet to show you what I mean.....

here is the code I have so far, modified from another thread I posted.

Sub dogs()
Dim rd As Worksheet, dg As Worksheet, i As Long
Dim fRng As Range, Crit

Application. ScreenUpdating = False

Set rd = Sheets("Pets")
Set dg = Sheets("Dog")

The attached is a very cut down version of my spreadsheet...