Verwenden Erweiterte Filterdaten in separaten Blatt kopieren

Question

Ich möchte

i mit Auto-Filter oder erweiterten Filter zum Filtern haben eine Master-Excel-Tabelle mit 400K Aufzeichnungen

Ich habe eine Liste von 31 alphanumerischen Daten

Ich muss Datensätze aus Master-Blatt kopieren, wenn Feld "K" hat eine dieser 31 alphanumerischen Daten

Ich versuchte mit folgenden. Es hat nicht funktioniert. Ihre Hilfe wäre willkommen.

Sub AAA_MyFilter() 
Dim ws1 As Worksheet 
Dim ws2 As Worksheet 
Dim ws3 As Worksheet 
Dim rng1 As Long 
Dim rng2 As Long 
Dim rng3 As Long 
Dim rng4 As Long 
Dim i As Long 
Dim x As Long 
Dim y As Long 

Set ws1 = Worksheets("Active") ' Data 
Set ws2 = Worksheets("NYorkPstlCode") ' Criteria 
Set ws3 = Worksheets("Consolidated") ' Output 

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

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


rng3 = ws3.Cells(Rows.Count, "A").End(xlUp).Row 
rng4 = ws1.Cells(Rows.Count, "J").End(xlUp).Row 

For i = 2 To rng4 

Set fltrDataField = ws1.Range("J" & i) 

For x = 2 To rng2 
Set filtrListField = ws2.Range("A" & x) 

For y = 2 To rng3 


ws1.Range("j" & i).AdvancedFilter Action:=xlFilterCopy, _ 
    CriteriaRange:=ws2.Range("A" & x), _ 
    CopyToRange:=ws3.Range("A2" & y), _ 
    Unique:=False 

    Next y 
    Next x 
    Next i 


End Sub 

Answer 1

Sub ProcessWorkSheets() kopiert Daten von "aktiv" filtriert und "passive" Blätter "Consolidated"

(wenn Active.ColK oder Passive.ColK enthalten Werte von NYorkPstlCode.ColA)

---

Option Explicit 

Public Sub ProcessWorkSheets() 
    With Application.ThisWorkbook 
     ConsolidatePostalCodes .Worksheets("Active") 'Last row determined by vals in col A 
     ConsolidatePostalCodes .Worksheets("Passive") 'Last row determined by vals in col A 
    End With 
End Sub 

---

Public Sub ConsolidatePostalCodes(ByRef wsD As Worksheet) 
    Const COL_A = "A" 
    Const COL_K = 11 
    Dim wsC As Worksheet, wsO As Worksheet, i As Long, t As Double 
    Dim lrD As Long, lrC As Long, lrO As Long, maxRows As Long 

    t = Timer 
    maxRows = Rows.Count 
    With Application.ThisWorkbook 
     Set wsC = .Worksheets("NYorkPstlCode")  'Criteria 
     Set wsO = .Worksheets("Consolidated")  'Output 
    End With 

    Application.ScreenUpdating = False 

    If wsD.AutoFilterMode Then wsD.UsedRange.AutoFilter 
    lrD = wsD.Cells(maxRows, COL_A).End(xlUp).Row 
    lrC = wsC.Cells(maxRows, COL_A).End(xlUp).Row 
    lrO = wsO.Cells(maxRows, COL_A).End(xlUp).Row + 1 

    For i = 2 To lrC 
     With wsD 
      With .UsedRange 
       .AutoFilter Field:=COL_K, Criteria1:=wsC.Cells(i, COL_A).Value2 
       .Resize(.Rows.Count - 1).Offset(1).Copy wsO.Cells(lrO, COL_A) 
      End With 
      lrO = wsO.Cells(maxRows, COL_A).End(xlUp).Row + 1 
     End With 
    Next 

    wsD.UsedRange.AutoFilter 
    Application.ScreenUpdating = True 

    Debug.Print "Time: " & Format(Timer - t, "#,##0.000") & " sec" 
End Sub 

---