Also ich hab jetzt deine Anpassungen bei meinem File auch gemacht aber dann funktioniert das Makro nicht mehr. Hab ich was falsch gemacht? Meine Änderung hab ich in Fett geschrieben.
Public Sub Main()
Dim colResult As Collection
Dim cFactory As New clsDataFactory
Dim cMatch As clsMatch
Dim col As String, cfind As Range
cFactory.dataFactory "Tabelle1"
Set colResult = cFactory.getMatchingItems
If Not colResult Is Nothing Then
Dim wks As Worksheet
Dim l As Long: l = 2
If WorksheetExist("Ergebnis") Then
Application.DisplayAlerts = False
ThisWorkbook.Worksheets("Ergebnis").Delete
Application.DisplayAlerts = True
End If
col = "Type"
With Worksheets("Tabelle1")
With .Range("A1", .Cells(1, .Columns.Count).End(xlToLeft))
Set cfind = .Find(what:=Haarfarbe, LookIn:=xlValues, lookat:=xlWhole)
If Not cfind Is Nothing Then
.AutoFilter Field:=cfind.Column, Criteria1:="blau"
.AutoFilter Field:=cfind.Column, Criteria1:="rosa"
End If
End With
.AutoFilterMode = False
End With
Set wks = ThisWorkbook.Worksheets.Add(after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
wks.Name = "Ergebnis"
With wks
.Cells(1, 1).Value = "Datum"
.Cells(1, 2).Value = "Nachname"
.Cells(1, 3).Value = "Vorname"
.Cells(1, 4).Value = "Geburtsort"
.Cells(1, 5).Value = "Geburtstag"
End With
For Each cMatch In colResult
With wks
.Cells(l, 1).Value = cMatch.Data1.Datum
.Cells(l, 2).Value = cMatch.Data1.Nachname
.Cells(l, 3).Value = cMatch.Data1.Vorname
.Cells(l, 4).Value = cMatch.Data1.Geburtsort
.Cells(l, 5).Value = cMatch.Data1.Geburtstag
End With
l = l + 1
Next cMatch
End If
If Not wks Is Nothing Then Set wks = Nothing
If Not colResult Is Nothing Then Set colResult = Nothing
If Not cFactory Is Nothing Then Set cFactory = Nothing
End Sub
Set cfind = .Find(what:=Haarfarbe, LookIn:=xlValues, lookat:=xlWhole)
.AutoFilter Field:=cfind.Column, Criteria1:="rosa"