vba - Excel VBA - 自动筛选(2 列/2 个条件)复制与条件不匹配的行

Question

当我使用以下 VBA 代码时:

With Range("A6:T" & lngLastRow)
    .AutoFilter
    .AutoFilter Field:=6, Criteria1:="Alexandra"
    .AutoFilter Field:=19, Criteria1:="-14"
    .Copy AlexSheet.Range("A3")
    .AutoFilter
End With

它复制自动筛选字段 6 中名称为“Alexandra”的行，同时复制自动筛选字段 19 中具有不同名称和不同值的 1 或 2 行(不是 -14)

我不知道是什么原因导致 Excel/VBA 复制我从未要求过的行。

希望有人能帮助我。

完整代码:

Sub DeleteFilterAndCopy()

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Sheets("Alex").Range("A3:T1000").clearcontents
Sheets("Anett Edith").Range("A3:T1000").clearcontents
Sheets("Angela").Range("A3:T1000").clearcontents
Sheets("Dirk").Range("A3:T1000").clearcontents
Sheets("Daniel").Range("A3:T1000").clearcontents
Sheets("Klaus").Range("A3:T1000").clearcontents
Sheets("Konrad").Range("A3:T1000").clearcontents
Sheets("Marion").Range("A3:T1000").clearcontents
Sheets("MartinX").Range("A3:T1000").clearcontents
Sheets("Michael").Range("A3:T1000").clearcontents
Sheets("Mirko").Range("A3:T1000").clearcontents
Sheets("Nils").Range("A3:T1000").clearcontents
Sheets("Ulrike").Range("A3:T1000").clearcontents

Dim lngLastRow As Long
Dim AlexSheet As Worksheet, AnettEdithSheet As Worksheet, AngelaShett As Worksheet, DanielSheet As Worksheet
Dim DirkSheet As Worksheet, KlausSheet As Worksheet, Konradsheet As Worksheet
Dim MarionSheet As Worksheet, MartinSheet As Worksheet, MichaelSheet As Worksheet, MirkoSheet As Worksheet
Dim NilsSheet As Worksheet, Ulrikesheet As Worksheet

Set AlexSheet = Sheets("Alex")
Set AnettEdithSheet = Sheets("Anett Edith")
Set AngelaSheet = Sheets("Angela")
Set DanielSheet = Sheets("Daniel")
Set DirkSheet = Sheets("Dirk")
Set KlausSheet = Sheets("Klaus")
Set Konradsheet = Sheets("Konrad")
Set MarionSheet = Sheets("Marion")
Set MartinSheet = Sheets("MartinX")
Set MichaelSheet = Sheets("Michael")
Set MirkoSheet = Sheets("Mirko")
Set NilsSheet = Sheets("Nils")
Set Ulrikesheet = Sheets("Ulrike")

lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row

With Range("A6:T" & lngLastRow)
    .AutoFilter
    .AutoFilter Field:=6, Criteria1:="Alexandra"
    .AutoFilter Field:=19, Criteria1:="-14"
    .Copy AlexSheet.Range("A3")
    .AutoFilter Field:=6, Criteria1:="Anett / Edith"
    .Copy AnettEdithSheet.Range("A3")
    .AutoFilter Field:=6, Criteria1:="Angela"
    .Copy AngelaSheet.Range("A3")
    .AutoFilter Field:=6, Criteria1:="Daniel"
    .Copy DanielSheet.Range("A3")
    .AutoFilter Field:=6, Criteria1:="Dirk"
    .Copy DirkSheet.Range("A3")
    .AutoFilter Field:=6, Criteria1:="Klaus"
    .Copy KlausSheet.Range("A3")
    .AutoFilter Field:=6, Criteria1:="Konrad"
    .Copy Konradsheet.Range("A3")
    .AutoFilter Field:=6, Criteria1:="Marion"
    .Copy MarionSheet.Range("A3")
    .AutoFilter Field:=6, Criteria1:="Martin"
    .Copy MartinSheet.Range("A3")
    .AutoFilter Field:=6, Criteria1:="Michael"
    .Copy MichaelSheet.Range("A3")
    .AutoFilter Field:=6, Criteria1:="Mirko"
    .Copy MirkoSheet.Range("A3")
    .AutoFilter Field:=6, Criteria1:="Nils"
    .Copy NilsSheet.Range("A3")
    .AutoFilter Field:=6, Criteria1:="Ulrike"
    .Copy Ulrikesheet.Range("A3")
    .AutoFilter
End With

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

End Sub

数据屏幕截图:

获取过滤器并从中复制的数据(橙色列 = 自动过滤器字段):

问题是，宏不仅复制包含 Planner Alexandra 和值 -14 的行，还复制两个单元格中具有不同值的 1-2 行。

问候

Answer 1

试试这个

With Range("A6:T" & lngLastRow)
    .AutoFilter Field:=6, Criteria1:="Alexandra"
    .AutoFilter Field:=19, Criteria1:="-14"
    .SpecialCells(xlCellTypeVisible).Copy AlexSheet.Range("A3")
End With