Macro to CUT & Paste a row to another sheet if "Active" appears in Column J

Try this

Sub steffen
On error resume next
Do
Sheets(1).Columns(10).Find("Active",,xlValues,xlWhole).EntireRow.Cut Destination:=Sheets("Active").Range("A60000").End(xlUp).Offset(1,0)
Loop until err.number <> 0
End sub