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

它会复制名称为＆＃34; Alexandra＆＃34;在自动过滤字段6中，还可以复制自动过滤字段19（不是-14）中具有不同名称和不同值的1或2行

我不知道是什么原因导致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

屏幕截图：

获取filteres并从中复制的数据（orange columns = autofilter fields）：

问题是，宏不仅复制包含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

Answer 2

     It's ? like how are you coping autofiltered data..
     Copy only special rows

     Range("A1").Select''Destination where want to paste
     'Use below code to paste
     Selection.PasteSpecial Paste:=xlPasteValue

Answer 3

'For each new FilterCombinations criteria call this sub or modify according to your need
Sub Macro()
Range("A1").Select ''Assuming that 1st row is for header
ActiveCell.Offset(1, 0).Select

Dim intSpRowCount As Integer
intSpRowCount = Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Rows.count

If Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Rows.count > 1 Then
'copy only visible range
Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(intSpRowCount - 1, Int(ActiveSheet.UsedRange.Rows.count) - 1)).Select
Selection.Copy

Sheets("Sheet3").Select
Range("A6").Select
ActiveSheet.Paste
End If
End Sub