excel - VB - Copy all rows with cell like ''

I am trying to create a macro that will search through my range and copy the entire row where cell like '*01'. It copies and paste to the sheet i need but it loops and copies just the same row, maybe i dont need the loop if there is an easier way to accomplish this. again all I really need is to copy all the rows that have a cell like'*01'and paste it in my new worksheet. This goes to every 5 rows down looking for the cell with that value. Thank you so much!

     Sub Macro3()
  'ctrl + l
  Dim GetBook As String

Dim cell As Range
Dim SrchRng As Range

GetBook = ActiveWorkbook.Name



Set SrchRng = ActiveSheet.Range("d7:d500")

Do Until IsEmpty(ActiveCell)
For Each cell In SrchRng
'And IsEmpty(ActiveCell.Offset(5, 0))
      If cell Like "*01" Then cell.Offset(0, 0).EntireRow.Copy
    Next cell

 Loop


    Windows("TestCov.xlsx").Activate
    ActiveWindow.WindowState = xlNormal

 Range("iv1").End(xlToLeft).Offset(0, 1).Select

    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True

        Windows(GetBook).Activate

    ActiveCell.Offset(5, 0).Select