Sub s()
Dim a As Range
Dim b As Range
Dim c As Long
Set a = Sheets("Sheet1").Range("A2:A" & Cells(65536, "A").End(xlUp).Row)
Set b = Sheets("Sheet1").Range("B2:B" & Cells(65536, "A").End(xlUp).Row)
Sheets("Sheet2").Select
Range("A2").Select
c = 2
Do Until c > Cells(65536, "a").End(xlUp).Row
If (Application.WorksheetFunction.SumProduct(r = "Yes" * s = ActiveCell.Value) >= 1) Then
Rows(c).Delete
Range("A" & c).Select
Else
ActiveCell.Offset(1, 0).Select
c = c + 1
End If
Loop
End Sub
|