[Tasos]

Καλησπέρα σε όλους!
Απευθύνομαι στο δημιουργό του θέματος τον Μανώλη.

Φίλε Μανώλη και εμείς είμαστε στο διαδίκτυο και νομίζω ότι τα καταφέρνουμε μια χαρά!

Στο θέμα μας λοιπόν.
Θέλεις να φιλτράρεις σε ένα φύλλο και ταυτόχρονα να φιλτράρονται και κάποια άλλα φύλλα που έχουν την ίδια δομή δεδομένων.

Βήμα 1:
Αφαιρείς το/τα TextΒox (προκαλούν αναταραχές στην οθόνη) και πληκτρολογείς το κριτήριο του αυτόματου φίλτρου στο κελί C6.
Αυτό ισχύει για όλα τα φύλλα που εμπλέκονται στην αναζήτηση και στο ταυτόχρονο φιλτράρισμα.

Βήμα 2:
Δημιουργείς ένα φύλλο (που αργότερα μπορείς να αποκρύψεις) με το κωδικό όνομα SheetList
που θα περιέχει το όνομα ArrSheets (Περιοχή A2:A10, μπορείς να το προσαρμόσεις στα μέτρα σου).
Στην περιοχή αυτή γράψε τα ονόματα των φύλλων που θα φιλτράρονται.

Βήμα 3:
Σε μια λειτουργική μονάδα πέρασε τον παρακάτω κώδικα:

Option Explicit
Public IsExecuting As Boolean
Dim c As Range, i As Integer

Sub ExecuteAllAutoFilters( _
    StartRange As String, _
    AutofilterField As Integer, _
    AutofilterCriteria As String, _
    ExcludedSheetName As String, _
    TargetAddress As String)

    For Each c In SheetList.Range("ArrSheets").SpecialCells(xlCellTypeConstants)
        With Parent.Worksheets(c.Text)
            If Not .Name = ExcludedSheetName Then
                If AutofilterCriteria = vbNullString Then
                    .AutoFilterMode = False
                Else
                    .Range(StartRange).AutoFilter Field:=AutofilterField, Criteria1:=AutofilterCriteria
                End If
                .Range(TargetAddress).Value = AutofilterCriteria
            End If
        End With
    Next
End Sub

Βήμα 4:

Στη λειτουργική μονάδα κλάσης του Βιβλίου (στο "ThisWorkBook", όχι των φύλλων) πέρασε τον παρακάτω κώδικα:

Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If IsExecuting Then Exit Sub
    If Intersect(Target, Range("C6")) Is Nothing Then Exit Sub
    If SheetList.Range("ArrSheets").Find(Sh.Name) Is Nothing Then Exit Sub
    IsExecuting = True
    Range("A7:C7").AutoFilter Field:=3, Criteria1:=Target.Text
    ExecuteAllAutoFilters _
            StartRange:="A7:C7", _
            AutofilterField:=3, _
            AutofilterCriteria:=Target.Text, _
            ExcludedSheetName:=Sh.Name, _
            TargetAddress:=Target.Address
    If Trim(Target) = vbNullString Then Sh.AutoFilterMode = False
    IsExecuting = False
End Sub

Μπορείς να δεις την ακριβή λειτουργία των παραπάνω στο αρχείο που επισυνάπτω.

Καλή συνέχεια!

Φιλικά

Τάσος