过滤Autofilter中的每个条件并将数据复制到另一个工作表

Question

我正在编写代码，我想知道是否有办法一次性使用Autofilter过滤所有条件（假设我们有三个条件）并使用VBA将数据复制到另一个工作表。我是添加图片以供参考。

Answer 1

使用数据透视表：

1. 创建数据透视表
2. 将指定拖到过滤器
3. 员工代码到行标签
4. 与值的距离

最后转到选项标签



如果要自动化，请记录这些步骤。

Answer 2

您始终希望尝试发布您尝试过的代码。请发布您的努力，鼓励人们出来帮助您。

我已经尝试了一段代码给你一个想法，请看看它们，如果有效，请告诉我。

Sub autofilter_copy()

    'Declare the Required Variables
    Dim Colm As Integer
    Dim lastrow As Long
    Dim i As Variant
    Dim ws As Worksheet

Set ws = Worksheets("Sheet1")

ws.Activate

'Get Column Number of Designation Column
Colm = WorksheetFunction.Match("Designation", Sheets("Sheet1").Rows(1), 0)

'Get Last row of the Designation Column
lastrow = ActiveSheet.Cells(Rows.Count, Colm).End(xlUp).Row

 ' Usage of Advanced Filter to get the Unique Values
ActiveSheet.Range("C1:C13").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("Sheet1").Range("D1"), Unique:=True

Range("D1").Value = "Designation Unique"

Colm2 = WorksheetFunction.Match("Designation Unique", Sheets("Sheet1").Rows(1), 0)

lastrow2 = ActiveSheet.Cells(Rows.Count, Colm2).End(xlUp).Row

'For loop to loop through the Unique values and paste the values in a new sheet.
For i = 2 To lastrow2

ws.Activate

UniqueValue = Range("D" & i).Value
Cells.Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$C" & lastrow).AutoFilter Field:=3, Criteria1:=UniqueValue
Cells.Select
Selection.Copy
Sheets.Add After:=ActiveSheet
ActiveSheet.Paste

ws.Activate
Next
End Sub