Vba 以更高效的方式复制并粘贴到表中

我有一个excel文件，包含两张工作表：

1.INFO（huuuge表格，约10.000行）
2.添加信息

第二个是我的问题所在。基本上，它有两个功能，要么过滤（基于两个不同的条件）和搜索表中的信息并将其显示在该表中，要么向表中添加新行。我制作的宏工作正常，但我觉得奇怪的是，1分钟太长，无法完成任务：

Sub Search_in_table()

Dim header As Range


Sheets("ADD INFO").Select
Range("A13").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp

If Worksheets("ADD INFO").[Item_to_search] = "Cust_ID" Then
    Sheets("INFO").Select
    Set header = [A1:Y1]
    With header
        .AutoFilter Field:=6, Criteria1:=Worksheets("INFO").[What_I_Want]
    End With

ElseIf Worksheets("ADD INFO").[Item_to_search] = "ASIN" Then
    Sheets("INFO").Select
    Set header = [A1:Y1]
    With header
        .AutoFilter Field:=4, Criteria1:=Worksheets("INFO").[What_I_Want]
    End With

End If

ActiveSheet.AutoFilter.Range.Copy
Sheets("ADD INFO").Select
Worksheets("ADD INFO").[A13].PasteSpecial

Sheets("INFO").Select
header.Select
Selection.AutoFilter

Sheets("ADD INFO").Select

End Sub

这是要添加新行的：

Sub add_esc()

Sheets("ADD INFO").Select
Range("Y9:A9").Select
Selection.Copy

Sheets("INFO").Select
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select

Selection.PasteSpecial

Sheets("ADD INFO").Select
Range("A9:Y9").Select
Selection.ClearContents

有没有办法让他们更有效率？我错过什么了吗？顺便说一句，我想要的和项到项搜索只是带名称的单元格。一个有趣的事实是，在编写代码的过程中，我在诸如“selection.paste”之类的内容中遇到了非常奇怪的错误，这就是为什么我使用了一种不常见的符号，如“Worksheets（“addinfo”）[A13].PasteSpecial”

---

非常感谢您的任何想法！！！提前谢谢

我建议尽可能摆脱“选择”和“激活”，这样可以加快速度并最终避免bug。例如，您是否能够清除工作表上的所有单元格（“添加信息”）？工作表（“添加信息”）.cells.clear

至于代码的其余部分：我不记得做过类似的事情，但理论听起来不错。。。不过，摆脱所有这些“选择”，它们只会让事情变慢。你有：

ActiveSheet.AutoFilter.Range.Copy
Sheets("ADD INFO").Select
Worksheets("ADD INFO").[A13].PasteSpecial

相反，只需使用此选项（要获得额外的积分，请不要使用Sheets（），请直接参考Sheets代码名：

wsInfo.autofilter.range.copy wsAddInfo.cells(13,1) ' i.e. row 13, column 1 (col A)

不确定问题的其余部分：添加行等，但使用上述方法，您可能只需要增加复制目标行？或使用application.worksheetfunction.counta（范围）查找最后使用的单元格，而不是“选择”等

您的方法可能实际上比手动迭代每一行并复制满足条件的位置要慢。这可能值得一试。例如：

for each rgCell in rgList
    if rgCell.offset(0,4) = stCrit1 _
        and rgcell.offset(0,8) = stCrit2  then
        rgcell.entirerow.copy wsAddInfo.cells(intDrawRow, intDrawCol)
        intDrawRow = intDrawRow + 1

    end if
next

如果所有其他方法都失败了，我强烈建议您在执行此操作之前先去掉代码中的所有“选择”，在代码开头使用application.screenUpdatement=false，在代码结尾使用application.screenUpdatement=true。强烈建议您进行错误处理，以便在出现错误时也将ScreenUpdate设置为true

干杯，先生