CODEWITHSUNDEEP
excelvba
peter.domanico
peter.domanico

Reputation: 61

Improve For loop speed when copying rows

I use the following For loop to copy rows from one sheet to another, based on the presence of a criteria in a column. I've started a new project where I need to copy tens of thousands of rows, and the performance isn't as quick as I'd like. I'm wondering if there is a more efficient way to accomplish this same task. I'm grateful for any suggestions.

Sub CopyThings()

    Dim Source As Worksheet
    Dim Target As Worksheet
    Dim c As Range
    Dim CriteriaRange As Range
    Dim CriteriaString As String
    Dim LastRow As Long
    Dim j As Integer
    Set Source = Worksheets("source data")
    Set Target = Worksheets("target sheet")
    LastRow = Source.Cells(Rows.Count, 1).End(xlUp).Row

    With Source
        Set CriteriaRange = Source.Range(.Cells(2, 5), .Cells(LastRow, 5))
    End With

    j = 2
        For Each c In CriteriaRange
            CriteriaString = c.Text
                Select Case CriteriaString
                    Case Is = "thing to copy"
                        Source.Rows(c.Row).Copy Target.Rows(j)
    j = j + 1
                End Select
            Next c

    Source.Rows(1).Copy Target.Rows(1)

End Sub

Upvotes: 0

Views: 63

Answers (1)

YowE3K
YowE3K

Reputation: 23974

You could try copying all the matching rows in one copy operation:

Sub CopyThings()
    With Worksheets("source data").UsedRange
        .AutoFilter
        .AutoFilter Field:=5, Criteria1:="=thing to copy"
        .Copy Worksheets("target sheet").Range("A1")
    End With
End Sub

Upvotes: 2

Related Questions