Hallo,

Ich habe jetzt bereits mehrere Versionen versucht, aber ich bekomme es einfach nicht zum Laufen. 

Auch bei der Forensuche stoße ich immer wieder auf die üblichen Verdächtigen, die bei mir nicht laufen.

Ich nehme an es liegt an den Sternchen, bekomme aber zumindest bei einigen Varianten einen Wert (der Letzte) raus.

Von Vorne:

Ich habe in der Spalte "B" einen Text

Dieser könnte so aussehen:

Nun muss ich über VBA Die Kriterien .BI, .AI, .BV und .AV ausfiltern. 

Dies habe ich am anfang nur mit "*.BI*" und "*.AI*" mit dem "Normalen Autofilter" und Operator:=xlOr gemacht und es hatte sehr gut geklappt.

Bis die beiden Kriterien BV und AV dazu kamen.

Jetzt habe ich einen neuen Code gebraucht.

Also nachgelesen und auf Array gekommen.

ActiveSheet.Range("$A$1:K" & loLetzte).Autofilter Field:=2, Criteria1:=Array("*.AI*", "*.BI*", "*.AV*", "*.BV*"), Operator:=xlFilterValues

= 0 Ergebnisse

ActiveSheet.Range("$A$1:K" & loLetzte).Autofilter Field:=2, Criteria1:=Array("*.AI*", "*.BI*", "*.AV*", "*.BV*"), Operator:=xlOr

= 1 Treffer mit BV

Also einen längeren Code genommen, der im endeffekt die Gleiche Funktion nutzt, aber alles über Variablen

    '** Autofilter mit mehreren Kriterien in Spalte B setzen
    '** Dimensionierung der Variablen
    Dim rngFilterRange As Range
    Dim lngCriteriaCount As Long
    Dim arrCriteria() As String
    '** Anzahl der Kriterien festlegen
    lngCriteriaCount = 4
    '** Variable neu dimensionieren da die Criterial mit 0 beginnen
ReDim arrCriteria(0 To lngCriteriaCount - 1)
    '** Filterkriterien festlegen

arrCriteria(0) = "*.AI*"
arrCriteria(1) = "*.BI*"
arrCriteria(2) = "*.AV*"
arrCriteria(3) = "*.BV*"
    
 '** Objektvariable setzen

Set rngFilterRange = ActiveSheet.Range("A1:K" & loLetzte)

 '** Autofilter setzen/ausführen

rngFilterRange.Autofilter Field:=2, Criteria1:=arrCriteria(), Operator:=xlOr
    
    
' Filtern nach AI und BI (Analog und Digital input und Virtuelle Analog und Digitale Werte)

ActiveSheet.Range("$A$1:K" & loLetzte).Autofilter Field:=2, Criteria1:=Array("*.AI*", "*.BI*", "*.AV*", "*.BV*"), Operator:=xlFilterValues
 

Gleiches Ergebniss (0 Treffer, mit Operator:=xlOr letzter Treffer)

Also einen ganz anderen Code, den ich nicht aufdröseln konnte:

Dim arr1, arr2
Dim Z As Long
arr1 = Range("B1:B100").Value
ReDim arr2(1 To UBound(arr1, 1)) As String
For Z = 2 To UBound(arr1)
    Select Case arr1(Z, 1)
        Case "*.AI*", "*.BI*", "*.AV*", "*.BV*"
        Case Else
            arr2(Z) = CStr(arr1(Z, 1))
    End Select
Next
Range("$B$1:$B$100").Autofilter Field:=2, Criteria1:=arr2, Operator:=xlFilterValues

Der hat mir überhaupt nichts gefiltert und mit Operator:=xlOr alles herausgefiltert

Es muss doch möglich sein mit VBA vier "Enthält" Kriterien zu Filtern. Zwei funktionieren doch auch.

Im Endeffekt möchte ich die gefilterten Zeilen in ein neues Tabellenblatt kopieren, nachdem ich in Spalte J nach 31 oder 61 gesucht habe.

Also: Wenn "B" = ("*.AI*"or "*.BI*"or "*.AV*"or "*.BV*") und ("J" = 31 or 61) dann Kopiere nach neues Sheet 

Wenn es Funktioniert mit dem Filtern, habe ich es auch hinbekommen.

' Name des neuen Sheet muss auf 31 Zeichen gekürzt werden
Dim Ort31 As String
Ort31 = Left(Ort, 31)
 'Neues Sheet erstellen und mit Namen versehen
 Worksheets.Add.Name = Ort31

 ' Nach Notivication Class 31 und 61 suchen und in neues Sheet Kopieren
  
  Dim Kopierange As Range
  Dim SuchZeile As Long

 ' Nach 31 suchen
 'Letzte Zeile feststellen
 With Worksheets(QSheet.Name)
    loLetzte = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
With Worksheets(QSheet.Name)
Set Kopierange = .Rows(1)
For SuchZeile = 1 To loLetzte
If .Cells(SuchZeile, 10).Value = 31 Then
Set Kopierange = Union(Kopierange, .Rows(SuchZeile))
End If
Next SuchZeile
'Kopierange.Copy Destination:=Worksheets(Ort31).Range("A1")
End With

 ' Nach 61 suchen

With Worksheets(QSheet.Name)

For SuchZeile = 1 To loLetzte
If .Cells(SuchZeile, 10).Value = 61 Then
Set Kopierange = Union(Kopierange, .Rows(SuchZeile))
End If
Next SuchZeile
Kopierange.Copy Destination:=Worksheets(Ort31).Range("A1")

End With

Ich hoffe ich habe euch nicht zu sehr verwirrt, Wollte aber Zeigen, das ich durchaus nach einer Lösung gesucht habe.

Danke