Copy If And

[billandrew]

Not sure what I am doing wrong. Any assistance or suggestions would be great..

Thank You

Trying to copy to another worksheet if meets two criteria. Code I am using is;

Application.ScreenUpdating = False

lr = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row

For w = 2 To lr
If Worksheets("Sheet1").Cells(w, 3).Value = "Green" And Cells(w, 5).Value = "No" Then
Worksheets("Sheet1").Rows(w).Copy

ThisWorkbook.Sheets.Add(after:=ThisWorkbook.Sheets(Sheets.Count)).Name = "Test"


lr2 = Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Test").Cells(lr2 + 1, 1).PasteSpecial

End If
Next w

Application.ScreenUpdating = True

End Sub

 

[Beyond_avarice]

Sub billandrew()

Dim lr As Long, lr2 As Long
Dim aWS As Worksheet

Application.ScreenUpdating = False

Set aWS = ActiveSheet
Sheets.Add(after:=Sheets(Sheets.Count)).Name = "Test"
aWS.Activate

lr = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
lr2 = 1

 For W = 2 To lr
    If Worksheets("Sheet1").Cells(W, 3).Value = "Green" And Cells(W, 5).Value = "No" Then
       
        Worksheets("Test").Rows(lr2).Value = Worksheets("Sheet1").Rows(W).Value
        lr2 = lr2 + 1
 
    End If
 Next W

 Application.ScreenUpdating = True
 End Sub

 

[billandrew]

This works perfect.

Not sure what is wrong with the code above. Should I have set the 3 variables?

 

[Beyond_avarice]

You had a copy with no destination to paste. your add worksheet wasn't set up correctly and if it was, inside your loop, it would have thrown an error with every iteration as it would have repeated on every true result. You didn't need to find the last row of lr2 because you are trying to find the last row of a new worksheet=1, then append to every True iteration.

 

[billandrew]

Thank You!