Office: (Office 2019) spezialfilter Wert kann in jeder Spalte sein

Einen schönen Guten Morgen
Ich würde gern mit {einem Filter} dem Gesuchten Wert finden welcher aber in Jeder Spalte vorkommen könnte, das geht leider nur bei einer Auswahl und macht Fehler bei einem 2 Kriterium
Vor allen geht es darum Text wie auch Zahlen {Nummern} zu finden.
Wie kann man das elegant und mit Mehren Kriterien hinbekommen bitte?
Ich danke für das lesen und auch eventueller Hilfe euerseits.
BILDER
UND TESTMAPPE

 

Hallo,
den Kriterienbereich verstehe ich nicht. Soll rot und q14 in jeder Zeile gefunden werden oder sollen die Zeilen übertragen werden, in der entweder das eine oder das andere steht? Warum stehen dort die Begriffe in jeder Zeile?
Gruß
Doming

 

Probiere mal das hier

 

hi ..Doming@ leider nicht was ich suche außer
man macht einen Bereich in der Tabelle für das Kriterium, da dieses Ja wechselt ( allerdings bis zu 10 verschiedene pro Spalte möglich.

Dein Code .... gut wäre hier einen Zellbereich als Kriterium Bereich zu setzen - leider reicht mein Verständnis noch nicht dafür
<
If .Cells(z, s).Text = "rot" Or .Cells(z, s).Text = "q14" Then

Code:

Private Sub Klickma()
 Dim z As Long, s As Long, Zielz As Long

    Zielz = 19
   
    With ThisWorkbook.Sheets(1)
        For z = 7 To 16
             For s = 5 To 14
                 If .Cells(z, s).Text = "rot" Or .Cells(z, s).Text = "q14" Then
                     Zielz = Zielz + 1
                     .Range("E" & z & ":N" & z).Copy Destination:=.Range("AA" & Zielz)
                     Exit For
                 End If
            Next s
        Next z
    End With
End Sub

 

So, Mr Bauer, ersetze mal meinen vorherigen Code durch diesen

Code:

Private Sub Klickma()
 Dim z As Long              'Zeile
 Dim s As Long              'Spalte
 Dim Zielz As Long          '1.Zeile Selektion
 Dim Anz As Long            'Anzahl der gefundenen Suchkriterien
 Dim n As Long              'Laufvariable
 Dim Zelle As Range         'Suchzelle
 Dim Krit() As String       'Katalog der gefundenen Suchkriterien
 Dim GibsSchon As Boolean   'doppeltes Suchkriterium
 Dim Ja As Boolean          'Zeile entspricht der Suche
    ReDim Krit(1)
    Zielz = 19
    With ThisWorkbook.Sheets(1)
   
'Suchkriterien sammeln-----
        For Each Zelle In .Range("Suchkriterien")
            If Zelle.Text <> "" Then
                n = 0
    '-----Prüfung ob Suchkriterium schon vorhanden
                Do Until n >= Anz
                    If Krit(n) = Zelle.Text Then
                        GibsSchon = True
                        Exit Do
                    End If
                    n = n + 1
                Loop
    '-----Wenn nicht vorhanden, dann dazuschreiben
                If Not GibsSchon Then
                    Krit(Anz) = Zelle.Text
                    Anz = Anz + 1
                    ReDim Preserve Krit(Anz)
                Else
                    GibsSchon = False
                End If
            End If
        Next Zelle
'Liste durchgehen---------
        For z = 7 To 16
            Ja = False
            For s = 5 To 14
                n = 0
                Do Until n = Anz
                    If .Cells(z, s).Text = Krit(n) Then
                        Ja = True
                        Exit Do
                    End If
                    n = n + 1
                Loop
                If Ja Then
                    Zielz = Zielz + 1
                    .Range("E" & z & ":N" & z).Copy Destination:=.Range("AA" & Zielz)
                    Exit For
                End If
            Next s
        Next z
    End With
    Set Zelle = Nothing
End Sub

Damit werden alle Zellen im Bereich Suchkriterien durchsucht und dann verglichen.

Gruß
Doming

 

Hallo Doming@ ich werde es heute mal Testen, danke auf jedenfalls für die Hilfe und melde mich wieder morgen.

 

Hallo Doming@
Ja super mit der Schleife - wäre mir selber nicht eingefallen danke das ist perfekt, werde es nun an meine Mappe anpassen.