Copy row into new workbook if certain cell meets criteria

[afcalan]

Hi

I am trying to copy the entire row to a new workbook if column P says Fail in it.

I want to loop this code until column c is empty. I also want to start the search at row 6 and start the pasting at row 2.

My code is below, but at the moment it appears to be stuck in an eternal loop...any pointers would be greatfully received.

Sub fails_defects_no_ws()
Dim i As String
Dim j As String
Dim uat As Workbook
Dim Results As Workbook
i = 6
j = 2
Set uat = ActiveWorkbook
Workbooks.Add
Set Results = ActiveWorkbook
uat.Activate
Sheets("Sheet1").Select
While Not IsEmpty(Cells(i, 3))
    If Range("P" & CStr(i)).Value = "Fail" Then
        Rows(CStr(i) & ":" & CStr(i)).Copy
        Results.Activate
        Range("A" & j).Select
        ActiveSheet.Paste
        j = j + 1
        
        
        uat.Activate
    Else
    
    End If
    
DataRowNum = datatrownum + 1
Wend
End Sub

 

[afcalan]

Please ignore...i've fixed this myself.
I was using an old reference 'datarownum' rather than i