|
So, oder so ähnlich - anpassen musste selbst
Sub Multifilter()
Dim Ws As Worksheet, Wsh As Worksheet
Const C_SHEETS As String = "MessungenRestglanz in %Eingabe"
Dim strName As String
Dim oFlt As Filter, rngFa As Range, rngFc As Range, rngTo As Range
Set Wsh = ActiveSheet
If Wsh.AutoFilterMode Then
Set rngFa = Wsh.AutoFilter.Range
Set rngFc = rngFa.Cells(1)
strName = Replace(C_SHEETS, Wsh.Name, "")
For Each Ws In ThisWorkbook.Sheets
If InStr(strName, Ws.Name) Then
Set rngTo = Ws.Cells.Find(rngFc.Value, , xlValues, xlWhole)
Set rngTo = rngTo.Resize(rngFa.Rows.Count)
For Each oFlt In Wsh.AutoFilter.Filters
If oFlt.Operator Then
rngTo.AutoFilter Field:=1, _
Criteria1:=Mid(oFlt.Criteria1, 2), _
Operator:=oFlt.Operator, _
Criteria2:=Mid(oFlt.Criteria2, 2)
Else
rngTo.AutoFilter Field:=1, _
Criteria1:=Mid(oFlt.Criteria1, 2)
End If
Next oFlt
End If
Next Ws
Else
For Each Ws In ThisWorkbook.Sheets
Ws.AutoFilterMode = False
Next Ws
End If
End Sub
|