想要从sheet2过滤和复制但不激活sheet2

Question

我有一个 Excel 文件，其中有 2 张纸。 从 Sheet1 中，想要过滤sheet2 表中的数据并将过滤后的数据复制并粘贴到sheet1 A1 单元格中。 可以通过sheet1本身完成它，而不需要激活或选择sheet2

我已经编写了代码，但过滤器仅在选择sheet2时才起作用

Sub Test()

On Error Resume Next

With Sheets("Sheet2")

    .ShowAllData

    .ListObjects("Table1").Range.AutoFilter Field:=(Rows("2").Find("Model").Column), Criteria1:= _
        "=DZIRE", Operator:=xlOr, Criteria2:="=Ertiga"
End With
    
    Range("Table1[Outlet Name],Table1[Supplier Category],Table1[Model]").Copy


    ActiveSheet.Paste


End Sub

Answer 1

复制筛选的 Excel 表格列

Option Explicit

Sub Test()
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim sws As Worksheet: Set sws = wb.Worksheets("Sheet2")
    Dim sTbl As ListObject: Set sTbl = sws.ListObjects("Table1")

    With sTbl.AutoFilter        
        If .FilterMode Then .ShowAllData ' remove previous filter
    End With
    
    sTbl.Range.AutoFilter Field:=sTbl.ListColumns("Model").Index, _
        Criteria1:="DZIRE", Operator:=xlOr, Criteria2:="=Ertiga"
    
    Dim svrg As Range: Set svrg = sTbl.Range.SpecialCells(xlCellTypeVisible)

    sTbl.AutoFilter.ShowAllData

    Dim srg As Range
    Set srg = Union(Intersect(svrg, sTbl.ListColumns("Outlet Name").Range), _
        Intersect(svrg, sTbl.ListColumns("Supplier Category").Range), _
        Intersect(svrg, sTbl.ListColumns("Model").Range))
    
    Dim dws As Worksheet: Set dws = wb.Worksheets("Sheet1")
    'dws.Cells.Clear ' clear the whole worksheet
    
    srg.Copy dws.Range("A1")

End Sub