2016-08-10 38 views
3

當我使用下面的VBA代碼:那些在名爲「亞歷山德拉」Excel的VBA - 自動篩選(2列/ 2標準)不與標準匹配的副本行

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

它複製行自動篩選字段6,但也複製1或2行,在自動篩選字段19(不是-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 

SCREENSHOTS的數據:

數據獲取filteres和從複製(橙色列=自動篩選字段): enter image description here

的問題是,該宏不僅複製包含Planner Alexandra和值-14的行,而且還是cop在兩個單元格中具有不同值的1-2行。

問候

+0

我不知道你在單元格A1的值通過A5?這可能會混淆自動過濾 –

+0

你是對的......這就是原因。請發表帖子,以便我可以標記您的答案 – Bluesector

+0

感謝您的更正。 –

回答

4

試試這個

With Range("A6:T" & lngLastRow) 
    .AutoFilter Field:=6, Criteria1:="Alexandra" 
    .AutoFilter Field:=19, Criteria1:="-14" 
    .SpecialCells(xlCellTypeVisible).Copy AlexSheet.Range("A3") 
End With 
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 
+0

選擇將無法正常工作,因爲功能更長,併爲15人和15張 – Bluesector

+0

發佈你現有的功能相同的事情。這將幫助我瞭解什麼是 –

+0

完成,看看帖子 – Bluesector

2
'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