Autofilter über mehrere Tabellenblätter
03.05.2018 17:08:47
Andreas
ich hoffe Ihr könnt mir helfen.
Mein Problem wie folgt:
Eine Excel-Datei mit mehreren Identischen Tabellenblättern für Berechnungen,
der Aufbau aller Blätter ist identisch.
Nun liegt ein Filter auf den Zellen A10:CW10 in Blatt 1 und dieser soll mittels Button (der sich auf Blatt 1 befindet) alle anderen Autofilter in allen Blätter identisch einstellen.
Folgende VBA habe ich gefunden, aber diese hat nur einmal funktioniert und den Filter nicht wieder geändert.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim iX As Integer, iXF As Integer
Dim arrFilter()
If Target.Address "$A$1" Then Exit Sub
Cancel = True
If ActiveSheet.AutoFilterMode = False Then Exit Sub
Application.EnableEvents = False
With ActiveSheet.AutoFilter
With .Filters
ReDim arrFilter(1 To .Count, 1 To 3)
For iXF = 1 To .Count
With .Item(iXF)
If .On Then
arrFilter(iXF, 1) = .Criteria1
If .Operator Then
arrFilter(iXF, 2) = .Operator
arrFilter(iXF, 3) = .Criteria2
End If
End If
End With
Next
End With
End With
For iX = 1 To ActiveWorkbook.Worksheets.Count
If Left(ActiveWorkbook.Worksheets(iX).Name, 5) = "Werk_" And _
ActiveWorkbook.Worksheets(iX).Name ActiveSheet.Name Then
With ActiveWorkbook.Worksheets(iX)
On Error Resume Next
.ShowAllData
On Error GoTo 0
For iXF = 1 To UBound(arrFilter(), 1)
If Not IsEmpty(arrFilter(iXF, 1)) Then
If arrFilter(iXF, 2) Then
.Cells.AutoFilter field:=iXF, Criteria1:=arrFilter(iXF, 1), _
Operator:=arrFilter(iXF, 2), Criteria2:=arrFilter(iXF, 3)
Else
.Cells.AutoFilter field:=iXF, Criteria1:=arrFilter(iXF, 1)
End If
End If
Next iXF
End With
End If
Next iX
MsgBox " Autofilter auf allen Blättern" & vbCrLf & _
"gemäss Blatt " & ActiveSheet.Name & " gesetzt!", _
vbOKOnly + vbInformation, "Auto-Autofilter"
Application.EnableEvents = True
End Sub
Gruß Andreas