Hallo,
mir fehlt bei folgender Situation ein bisschen die Logik.
Ich durchsuche Spalte R nach den Zahlen 1,2,3 & 4. Wenn eine der Zahlen gefunden wurde, dann wird die gesamte Tabelle (Spalte R) nach dieser Zahl gefiltert und mir die Ergebnisse in ein anderes Tabellenblatt kopiert. Soweit so gut.
Nun habe ich das ganze in eine If-ElseIf-Else Bedingung verpackt. Wenn nun aber bsps. die Zahl 2 gefunden wurde, wird mir die restliche Tabelle nicht mehr nach den Zahlen 3 & 4 durchsucht. Was vollkommen logisch ist, mir fällt nur leider keine andere Möglichkeit ein wie ich alles durchsuchen kann. Danke für eure Ideen!
If WorksheetFunction.CountIf(Range("R:R"), "1") > 0 Then
ActiveSheet.Range("A1:W" & letzteZeile).Autofilter Field:=18, Criteria1:="1"
freieZeileTab = Worksheets("Namensliste").Cells(Rows.Count, 1).End(xlUp).Row
Set C = Range("R2:R" & letzteZeile)
Set tt = Sheets("Namensliste").Cells(freieZeileTab + 1, 1)
C.Copy Destination:=tt
Set D = Range("B2:B" & letzteZeile)
Set uu = Sheets("Namensliste").Cells(freieZeileTab + 1, 2)
D.Copy Destination:=uu
freieZeileTab = Worksheets("Namensliste").Cells(Rows.Count, 1).End(xlUp).Row
ElseIf WorksheetFunction.CountIf(Range("R:R"), "2") > 0 Then
ActiveSheet.Range("A1:W" & letzteZeile).Autofilter Field:=18, Criteria1:="2"
freieZeileTab = Worksheets("Namensliste").Cells(Rows.Count, 1).End(xlUp).Row
Set C = Range("R2:R" & letzteZeile)
Set tt = Sheets("Namensliste").Cells(freieZeileTab + 1, 1)
C.Copy Destination:=tt
Set D = Range("B2:B" & letzteZeile)
Set uu = Sheets("Namensliste").Cells(freieZeileTab + 1, 2)
D.Copy Destination:=uu
freieZeileTab = Worksheets("Namensliste").Cells(Rows.Count, 1).End(xlUp).Row
ElseIf WorksheetFunction.CountIf(Range("R:R"), "3") > 0 Then
ActiveSheet.Range("A1:W" & letzteZeile).Autofilter Field:=18, Criteria1:="3"
freieZeileTab = Worksheets("Namensliste").Cells(Rows.Count, 1).End(xlUp).Row
Set C = Range("R2:R" & letzteZeile)
Set tt = Sheets("Namensliste").Cells(freieZeileTab + 1, 1)
C.Copy Destination:=tt
Set D = Range("B2:B" & letzteZeile)
Set uu = Sheets("Namensliste").Cells(freieZeileTab + 1, 2)
D.Copy Destination:=uu
freieZeileTab = Worksheets("Namensliste").Cells(Rows.Count, 1).End(xlUp).Row
ElseIf WorksheetFunction.CountIf(Range("R:R"), "4") > 0 Then
ActiveSheet.Range("A1:W" & letzteZeile).Autofilter Field:=18, Criteria1:="4"
Set C = Range("R2:R" & letzteZeile)
Set tt = Sheets("Namensliste").Cells(freieZeileTab + 1, 1)
C.Copy Destination:=tt Set D = Range("B2:B" & letzteZeile)
Set uu = Sheets("Namensliste").Cells(freieZeileTab + 1, 2)
D.Copy Destination:=uu
End If