复制行

Question

我使用以下For循环将行从一个工作表复制到另一个工作表，具体取决于列中是否存在条件。我已经开始了一个新项目，我需要复制数万行，而且性能并不像我想的那么快。我想知道是否有更有效的方法来完成同样的任务。我很感激任何建议。

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

Answer 1

您可以尝试在一个复制操作中复制所有匹配的行：

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