Autofilter auf mehrere Tabellenblätter

Hallo zusammen,
mein Problem ist ähnlich dieses Threads:
https://www.herber.de/forum/archiv/976to980/979392_Autofilter_ueber_mehrere_Tabellenblaetter.html
Im konkreten Fall habe ich mehrere Datenblätter - alle beginnen mit TB_ - die alle Autofilter im Bereich A13:D13 aufweisen. Für mich ist nun relevant, das der Filter, der in B13 gesetzt wird, für alle Blätter übernommen wird.
Anbei habe ich eine Beispieldatei hochgeladen. Es gibt mehr als die dort vorhandenen 2 Tabellenblätter.
Leider kann ich VBA Codes nur mit Hilfe der Makroaufzeichnung adaptieren - der konkrete Fall ist mir zu abstrakt - ich hoffe Ihr könnt mir helfen.
Vielen Dank.

https://www.herber.de/bbs/user/105335.xlsx  _
_
_
_
a>

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Thomas,
Kopiere untenstehenden Code in DieseArbeitsmappe

Option Explicit
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As  _
Boolean)
Const cWsPrefix As String = "TB_"
Const cRcTest As String = "$B$13"
Dim iX As Integer, iXF As Integer
Dim arrFilter()
If Sh.Type = xlWorksheet And Left(Sh.Name, Len(cWsPrefix)) = cWsPrefix Then
If Sh.AutoFilterMode = False Then Exit Sub
If Target.Address = cRcTest Then
Cancel = True
With Sh.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 Worksheets.Count
If Left(Worksheets(iX).Name, Len(cWsPrefix)) = cWsPrefix And _
Worksheets(iX).Name  Sh.Name Then
With 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 "Filter Einstellung wurde auf alle TB_Blätter übertragen!", vbInformation '  _
bei Bedarf auskommentieren
End If
End If
End Sub

Wenn du nun in einem "TB_Blatt" den Filter in B13 änderst, machst du anschliessend einen Rechtsklick in die Zelle und damit wird die Einstellung auf alle anderen "TB_Blätter" übertragen.
Gruess Hansueli

Beliebteste Forumthreads (12 Monate)

Autofilter auf mehrere Tabellenblätter

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

93 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Autofilter auf mehrere Tabellenblätter

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

93 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread