Excel VBA – Autofilter（2列/ 2条）复制与条件不匹配的行
当我使用下面的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中（不是-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
数据的屏幕截图：
从（orange columns = autofilter字段）获取过滤和复制的数据： 
问题是，该macros不仅复制包含Planner Alexandra和值-14的行，还复制了在两个单元格中具有不同值的1-2行。
问候
尝试这个
With Range("A6:T" & lngLastRow) .AutoFilter Field:=6, Criteria1:="Alexandra" .AutoFilter Field:=19, Criteria1:="-14" .SpecialCells(xlCellTypeVisible).Copy AlexSheet.Range("A3") End With
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
'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