简体   繁体   中英

VBA Match Criteria and paste

I need this code to search through a table in sheet1 and copy across the rows which match a certain criteria,

any tips on where I am going wrong?

Sub find_orders()

Application.ScreenUpdating = False

Dim r As Long, endRow As Long, pasteRowIndex As Long

endRow = Sheets("sheet1").Cells(Rows.Count, 2).End(xlUp).Row

pasteRowIndex = 2

For r = 2 To endRow
    If Cells(r, 6) = "d" Then
        Range(Cells(r, 2), Cells(r, 6)).Copy
        Sheets("sheet2").Select
        Range(Cells(pasteRowIndex, 2), Cells(pasteRowIndex, 6)).Select

        pasteRowIndex = pasteRowIndex + 1
        Sheets("sheet1").Select


        End If

Next r

End Sub

As @findwindow stated you need to qualify all your ranges and cells:

Sub find_orders()

Application.ScreenUpdating = False

Dim r As Long, endRow As Long, pasteRowIndex As Long
Dim ows As ws
Dim tws As ws

Set ows = Sheets("Sheet1")
Set tws = Sheets("Sheet2")

With ows
    endRow = .Cells(Rows.Count, 2).End(xlUp).Row

    pasteRowIndex = 2

    For r = 2 To endRow
        If .Cells(r, 6) = "d" Then
            .Range(.Cells(r, 2), .Cells(r, 6)).Copy
            tws.Range(tws.Cells(pasteRowIndex, 2), tws.Cells(pasteRowIndex, 6)).PasteSpecial
            pasteRowIndex = pasteRowIndex + 1
        End If
    Next r
End With

End Sub

By qualifieng the ranges you can avoid using the .Select command. Which slows done the code.

Try the following:

Sub find_orders()

Application.ScreenUpdating = False

Dim r As Long
Dim endRow1 As Long
Dim endRow2 As Long

endRow1 = Sheets("sheet1").Cells(Sheets("sheet1").Rows.Count, 2).End(xlUp).Row
endRow2 = Sheets("sheet2").Cells(Sheets("sheet2").Rows.Count, 2).End(xlUp).Row
endRow2 = endRow2 + 1

For r = 2 To endRow
    If Cells(r, 6) = "d" Then     'searches in column f for the letter "d" in a cell, correct?
        Range(Cells(r, 2), Cells(r, 6)).Select
        Selection.Copy
        Sheets("sheet2").Select
        Range(Cells(endrow2, 2), Cells(endrow, 6)).Select
        Selection.Paste

        Sheets("sheet1").Select

     End If
Next r

End Sub

The Problem is that in your code the pasteRowIndex was always 2 as you had defined it before the if-loop (I had the same problem once). I also added a little more informations in your code, as it is always good to be very specific especially in VBA ;)

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM