想要从工作表2过滤和复制，但不激活工作表2

Question

我有一个excel文件，其中有两张表。从Sheet1，希望过滤sheet2表中的数据，并将过滤后的数据复制粘贴到Sheet1 A1单元格中。是否可以在不激活或选择纸张2 的情况下通过纸张1本身完成

我已经写了代码，但过滤器只有当纸2被选择时才起作用

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