Issue in copying rows based on certain conditions in Vba - vba

Question

Set ws4 = Workbooks("A.xlsx").Worksheets(1)
Lastrowto = ws4.Cells(Rows.Count, "B").End(xlUp).Row
For y = Lastrowto To 1 Step -1
If ws4.Cells(y, "B").Value = "Not found" Then
ws4.Rows(y).EntireRow.Copy
End If
Next y
The above piece of vba code copies only 1 (the first one) row but I want to copy all those rows for which the given condition is met, kindly suggest me the correct version of code.

Answer 1

Instead of using Copy>>Paste one row at a time, which will take a long time to process, you can use a Range object named CopyRng.
Every time the criteria is met (If .Range("B" & y).Value = "Not found"), it will add the current row to CopyRng.
After finishing looping through all your rows, you can just copy the entire rows at once using CopyRng.Copy.
Code
Option Explicit
Sub CopyMultipleRows()
Dim ws4 As Worksheet
Dim Lastrowto As Long, y As Long
Dim CopyRng As Range
Set ws4 = Workbooks("A.xlsx").Worksheets(1)
With ws4
Lastrowto = .Cells(.Rows.Count, "B").End(xlUp).Row
For y = Lastrowto To 1 Step -1
If .Range("B" & y).Value = "Not found" Then
If Not CopyRng Is Nothing Then
Set CopyRng = Application.Union(CopyRng, .Rows(y))
Else
Set CopyRng = .Rows(y)
End If
End If
Next y
End With
' copy the entire rows of the Merged Range at once
If Not CopyRng is Nothing Then CopyRng.Copy
End Sub

Answer 2

Where do you want to copy it to? if you specify a destination to your copy, then your code could work.
e.g. if you have a destination sheet defined as wsDest, you can replace
ws4.Rows(y).EntireRow.Copy
by
ws4.Rows(y).EntireRow.Copy wsDest.cells(rows.count,1).end(xlup).offset(1)
assuming you always have a value in column 1.
Another option is to do an autofilter on column B, with the value not found, and use the specialcells property to copy to another spot. Recording a macro will help you quite a bit, but code will be something like:
with ws4.cells(1,1).currentregion
.autofilter field:=2,criteria1:="Not found"
.specialcells(xlcelltypevisible).copy
end with

Answer 3

You are copying but there is no paste line.
An example, with a paste line destination of ws1.Cells(counter,"B"), assuming another worksheet variable ws1 might be:
ws4.Rows(y).EntireRow.Copy ws1.Cells(counter,"B")
See the following where a msgbox shows you each time you are entering loop and have met the condition so are copying:
Public Sub test1()
Dim ws4 As Worksheet
Dim lastrowto As Long
Dim y As Long
Dim counter As Long
Set ws4 = ThisWorkbook.Worksheets("Ben")
lastrowto = ws4.Cells(ws4.Rows.Count, "B").End(xlUp).Row 'fully qualify
counter = 0
For y = lastrowto To 1 Step -1
If ws4.Cells(y, "B").Value = "Not found" Then
ws4.Rows(y).EntireRow.Copy 'put paste destination code here e.g. ws1.Cells(counter,"B") where ws1 would be another sheet variable
counter = counter + 1
Msgbox counter 'if has entered loop print current count
End If
Next y
End Sub