Endless loop?

I have a piece of code that I am experimenting with and it crashes my
excel... have I set up an endless loop? The idea is that if a certian column
in the *** equals "true" then cut that row and paste it into a new ***.

Thanks for the help!

Sub NI()
'

'
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Sheets("t0983101").Select
Range("E4").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("A4").Select
Dim rngToSearch As Range
Dim wks As Work***
Dim rngFound As Range

Set wks = Sheets("t0983101")
Set rngToSearch = wks.Columns(24)

Set rngFound = rngToSearch.Find("true")
If rngFound Is Nothing Then
MsgBox "No NI Trades Found"
Else
Do
rngFound.EntireRow.Cut
Sheets("NI").Select
Range("A9").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Active***.Paste
Set rngFound = rngToSearch.FindNext
Loop Until rngFound Is Nothing
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub



.

Loading