Excel 将表行复制到具有多个条件的新表中-是否仅复制第一行？

我有一个项目，我希望你们中的一些人能帮助我解决我的问题。独家报道如下：

我有一个Excel工作表，其中包含大量数据。我需要根据多个条件复制数据行，并将其粘贴到其他工作表中的另一个表中。第二个表应该扩展以容纳任意多行的信息。类似这样的内容（假设这些是Excel中的表格）：

如果一行第一列包含Mary，第三列包含300，则该行应复制到另一个工作表中的新表中，该工作表如下所示：

   |    A    |    B    |    C    |    D    |
|1 |Name^    |Fruit^   |Amount^  |Strata^  |
|2 |Mary     |Apples   |300      |Sand     |
|3 |Mary     |Bananas  |300      |Sand     |

我遇到的问题是，我可以获取要复制的行，但它们在第二个表下面执行，或者我只能获取要粘贴到新表中的第一行数据。迄今为止的守则是：

Public Sub CopyRows()
    ' Select starting sheet with data table
    Sheets("Full data").Select

    ' loop through all rows
    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
    For x = 2 To FinalRow
        ThisValue = Cells(x, 8).Value
        ' Set filtering criteria and copy matching cells
        If Cells(x, 8) = "PHONE" And Cells(x, 14) = "v" Then
            Cells(x, 1).Resize(1, 33).Copy
            ' Select sheet where second table is located
            Sheets("By Phone, Verified").Select
            ' Select the second table
            Range("Table2[Company]").Select
            ListObject = Cells(Rows.Count, 3).End(xlUp).Row + 1
            ' paste the rows of data
            ActiveSheet.Paste
        End If
    Next x
End Sub

第二个表仅以一个标题和一行开始，两个表都从其工作表的第三行开始

---

有没有办法把复制的数据放到第二个表中？如果需要更多的澄清，请告诉我

在不知道完整表结构的情况下，我猜最后一个

ActiveSheet.Paste

是在旧行上重复粘贴新行

尝试在VB编辑器中使用

F8

一步一步地运行宏，并查看所选内容及其粘贴位置

两条建议

对于较小的数据集，请使用

For i

循环，并尝试将

粘贴

命令更改为

插入

，以便在结果表顶部添加新行

对于较大的数据集，请避免使用循环。而是使用筛选器选择所有需要的行，复制筛选结果并粘贴这些行

根据经验，循环方法更容易编写，但在大型数据集上速度较慢。我会建议这样的事情

'Clear any existing filters from Stats
Sheets("Full Data").Select

If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilter.Sort.SortFields.Clear
If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False


'Apply the filter(s)
'Range references should be absolute $A$1:$Z$26
'Field refers to the column number within that range
'Find non-blank columns with Criteria "<>"
ActiveSheet.Range("<<your source range>>").AutoFilter Field:=1, Criteria1:="Mary"
ActiveSheet.Range("<<your source range>>").AutoFilter Field:=3, Criteria1:="300"

'Select and copy the rows
'Use A1:D1 to include headers or A2:D2 to exclude
Range("A1:D1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

'Paste into your results

'Remember to come back and clear the filters afterwards
Sheets("Full Data").Select

If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilter.Sort.SortFields.Clear
If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False

“从统计信息中清除任何现有筛选器
工作表（“完整数据”）。选择
如果为ActiveSheet.AutoFilterMode，则为ActiveSheet.AutoFilter.Sort.SortFields.Clear
如果是ActiveSheet.AutoFilterMode，则ActiveSheet.AutoFilterMode=False
'应用过滤器
'范围引用应为绝对值$A$1:$Z$26
'字段是指该范围内的列号
'查找具有条件的非空列“”
ActiveSheet.Range（“”）。自动筛选字段：=1，标准1:=“Mary”
ActiveSheet.Range（“”）。自动筛选字段：=3，标准1:=300
'选择并复制行
'使用A1:D1包含标题，或使用A2:D2排除标题
范围（“A1:D1”）。选择
范围（选择，选择。结束（xlDown））。选择
选择，复制
'粘贴到您的结果中
‘记得回来后清理过滤器
工作表（“完整数据”）。选择
如果为ActiveSheet.AutoFilterMode，则为ActiveSheet.AutoFilter.Sort.SortFields.Clear
如果是ActiveSheet.AutoFilterMode，则ActiveSheet.AutoFilterMode=False
谢谢CJC，我发现代码：

Public Sub CopyRows()
    Sheets("Full data").Select
    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
    For x = 2 To FinalRow
    If Cells(x, 8) = "PHONE" And Cells(x, 14) = "v" Then
    Cells(x, 1).Resize(1, 33).Copy
        Sheets("By Phone, Verified").Select
        NextRow = Cells(Rows.Count, 3).End(xlUp).Row + 1
        Cells(NextRow, 1).Select
        ActiveSheet.Paste
        Sheets("Full data").Select
    End If
Next x    
End Sub

执行所需操作，但不会将行粘贴到表中。你肯定是对的，它的速度非常慢，超过5公里的行以不同的方式被分成大约10个工作表，这将是一个全天的活动！如果有更好的过滤方法，我完全赞成

Public Sub CopyRows()
    Sheets("Full data").Select
    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
    For x = 2 To FinalRow
    If Cells(x, 8) = "PHONE" And Cells(x, 14) = "v" Then
    Cells(x, 1).Resize(1, 33).Copy
        Sheets("By Phone, Verified").Select
        NextRow = Cells(Rows.Count, 3).End(xlUp).Row + 1
        Cells(NextRow, 1).Select
        ActiveSheet.Paste
        Sheets("Full data").Select
    End If
Next x    
End Sub