CODEWITHSUNDEEP
vbaexcel
yashika vaish
yashika vaish

Reputation: 201

Issue in copying rows based on certain conditions in Vba

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.

Upvotes: 0

Views: 64

Answers (3)

Shai Rado
Shai Rado

Reputation: 33682

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

Upvotes: 1

QHarr
QHarr

Reputation: 84465

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

Upvotes: 0

nutsch
nutsch

Reputation: 5962

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

Upvotes: 0

Related Questions