XL 2019 Plusieurs Worksheet_Change sur la même feuille

Rabeto · 7 Décembre 2023

Bonjour à tous,

Quelqu'un a une solution svp

J'aimerai fusionner ces 2 macros qui font des filtres automatique selon la valeur d'une cellule sur la même feuille svp
Est ce possible également d'enlever le filtre avant le lancement de chaque macro ?

-------------------------------------------------------
Private Sub Worksheet_Change(ByVal T As Range)
If Not Intersect(T, [A1]) Is Nothing Then
Range("A15:A" & Cells(Rows.Count, "A").End(xlUp).Row).AutoFilter 1, [A1]
End If
End Sub
-------------------------------------------------------
Private Sub Worksheet_Change(ByVal X As Range)
If Not Intersect(X, [B1]) Is Nothing Then
Range("B15:B" & Cells(Rows.Count, "B").End(xlUp).Row).AutoFilter 1, [B1]
End If
End Sub
-------------------------------------------------------

PS : j'ai trouvé des sujets similaires sur le forum mais je n'arrive pas à adapter mon code avec les solutions proposées.

job75 · 7 Décembre 2023

Bonjour à tous,

VB:

Private Sub Worksheet_Change(ByVal T As Range)
With Range("A15:B" & Cells.SpecialCells(xlCellTypeLastCell).Row)
    If .Row < 15 Then Exit Sub
    If Not Intersect(T, [A1:B1]) Is Nothing Then .AutoFilter: .AutoFilter 'ôte le filtre
    If Not Intersect(T, [A1]) Is Nothing Then .AutoFilter 1, [A1]
    If Not Intersect(T, [B1]) Is Nothing Then .AutoFilter 2, [B1]
End With
End Sub

A+

patricktoulon · 7 Décembre 2023

Bonjour
compile tout dans un seul event dans un select case true

VB:

Private Sub Worksheet_Change(ByVal T As Range)
     If ActiveSheet.AutoFilterMode Then
       ActiveSheet.AutoFilterMode = False
     End If
    Select Case True
    Case Not Intersect(T, [A1]) Is Nothing
        Range("A15:A" & Cells(Rows.Count, "A").End(xlUp).Row).AutoFilter 1, [A1]

    Case Not Intersect(X, [B1]) Is Nothing
        Range("B15:B" & Cells(Rows.Count, "B").End(xlUp).Row).AutoFilter 1, [B1]

        'case blablabla
        'etc..etc..
    End Select

End Sub

fanfan38 · 7 Décembre 2023

Bonjour
Est ce seulement A1 et B1 qui change ou une cellule de la colonne...
Ci joint ma solution pour A1 ou B1

VB:

Private Sub Worksheet_Change(ByVal T As Range)
  T.AutoFilter
  If T.Address = "$A$1" Then
    Range("A15:A" & Cells(Rows.Count, "A").End(xlUp).Row).AutoFilter 1, [A1]
  ElseIf T.Address = "$B$1" Then
    Range("B15:B" & Cells(Rows.Count, "B").End(xlUp).Row).AutoFilter 1, [B1]
  End If
End Sub

A+ François

patricktoulon · 7 Décembre 2023

re
effectivement @fanfan38 a raison ,si c'est simplement A1 ou B1 on peut simplifier

VB:

Private Sub Worksheet_Change(ByVal T As Range)
    If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False

    Select Case T.Address(0, 0)

    Case "A1": Range("A15:A" & Cells(Rows.Count, "A").End(xlUp).Row).AutoFilter 1, [A1]

    Case "B1": Range("B15:B" & Cells(Rows.Count, "B").End(xlUp).Row).AutoFilter 1, [B1]

    End Select

End Sub

job75 · 7 Décembre 2023

Bonjour à tous,

VB:

Private Sub Worksheet_Change(ByVal T As Range)
With Range("A15:B" & Cells.SpecialCells(xlCellTypeLastCell).Row)
    If .Row < 15 Then Exit Sub
    If Not Intersect(T, [A1:B1]) Is Nothing Then .AutoFilter: .AutoFilter 'ôte le filtre
    If Not Intersect(T, [A1]) Is Nothing Then .AutoFilter 1, [A1]
    If Not Intersect(T, [B1]) Is Nothing Then .AutoFilter 2, [B1]
End With
End Sub

A+

patricktoulon · 7 Décembre 2023

re
bonjour @job75

VB:

If Not Intersect(T, [A1:B1]) Is Nothing Then .AutoFilter: .AutoFilter 'ôte le filtre

si le filtre n'y était pas ?

job75 · 7 Décembre 2023

Si le filtre n'est pas en place cette instruction ne change rien.

Elle est classique et fonctionne aussi sur un tableau structuré.

patricktoulon · 7 Décembre 2023

je crois me souvenir qu'elle causait des soucis sur sur 2007
c'est pour ça que j'ai demandé

job75 · 7 Décembre 2023

Par contre

If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False

ne fonctionne pas avec un tableau structuré.

Rabeto · 7 Décembre 2023

fanfan38 à dit:
Est ce seulement A1 et B1 qui change ou une cellule de la colonne...

Bonjour à tous,

et merci pour vos réponses,

En réponse à la question de fanfan38, seulement A1 ou B1 change.

Vous avez tous résolu la demande, merci

XL 2019 Plusieurs Worksheet_Change sur la même feuille

Rabeto

XLDnaute Occasionnel

Pièces jointes

job75

patricktoulon

XLDnaute Barbatruc

fanfan38

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Rabeto

XLDnaute Occasionnel

Discussions similaires