Question

我正在尝试复制Excel Sheet1和A中具有特定值的Excel工作表B中的所有行。然后将它们粘贴到新工作表Sheet2中。我的具体示例是，我已经想出要复制列0中A以及列4000中B的行。

我遇到的问题是代码会复制0列中A的所有行，而不仅仅是符合这两种条件的行。

我的代码如下：

Sub Temp_copy()
    set i = Sheets("Sheet1")
    set e = Sheets("Sheet2")
    Dim d
    Dim j
    d = 1
    j = 2

    Do Until IsEmpty(i.Range("A" & j))
        If i.Range("A"&j) = Range("B6"&j) And i.Range("B" & j) = Range(B"10"&j) Then
            d=d+1
            e.Rows(d).Value=i.Rows(j).Value
        End If
        j = j+1
    Loop

End Sub

希望这是有道理的。我是VBA的新手，所以任何帮助或指导，以实现我的需要将非常感激。

Answer 1

您可以使用AutoFilter() Range对象的Sub foo() Dim wsResult As Worksheet Set wsResult = Sheets("Sheet02") With Worksheets("Sheet01") With .Range("A2:B" & .Cells(.Rows.Count, "A").End(xlUp).Row) 'reference its columns A:B cells from row 2 (header) down to last not empty one in column "A" (If you need to copy more columns than simply adjust "A2:B" to whatever columns range you need) .AutoFilter field:=1, Criteria1:="0" ' filter referenced cells on 1st column with "0" content .AutoFilter field:=2, Criteria1:="4000" ' filter referenced cells on 2nd column with "4000" content If Application.WorksheetFunction.Subtotal(103, .Columns(1)) > 1 Then .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy Destination:=wsResult.Range("A1") ' if any filtered cell other than the header then copy their first five columns and paste to 'wsResult' sheet starting from its column A last not empty cell End With .AutoFilterMode = False End With End Sub方法，如下所示（注释中的解释）：

listview

Answer 2

试试这个：

Sub Temp_Copy()
    Dim cl As Range, rw As Integer

    rw = 1
    For Each cl In Worksheets("Sheet1").Range("A1:A10") //Set range as needed
        If cl = 0 And cl.Offset(0, 1) = 4000 Then
            cl.EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & rw)
            rw = rw + 1
        End If
    Next cl
End Sub

如何复制多列excel中具有特定值的所有行？

2 个答案: