Here is the code I have it is only coping one row over to sheet 2 and I have not been able to figure out why. I just want to look through column ED and find some text, cut the row and put it in sheet 2. But it cuts the rows but only pasts on row in sheet 2.

Dim fCell As Range
Dim wsSearch As Worksheet
Dim wsDest As Worksheet

Set wsSearch = Worksheets(“Sheet1”)
Set wsDest = Worksheets(“Sheet2”)

With wsSearch.Range("ED:ED")

Set fCell = .Find(what:="Balance Forward from EPIC", LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)

Do Until fCell Is Nothing
    fCell.EntireRow.Cut Destination:=wsDest.Cells(.Rows.Count, "A").End(xlUp).Offset(1)
    fCell.EntireRow.Delete

        Set fCell = .Find(what:="Balance Forward from EPIC", LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
    Loop
End With