Faire fonctionner le filtre d'un tableau dans une feuille a chaque fois que je vais dessus

moi_ces_moi · 28 Décembre 2019

Bonjour,

J'ai un classeur avec une feuille par jour, le nom de la feuille est égale a la cellule A3 (une date), je voudrai bien quand je clic sur une feuille que le tableau dessus soit filtré.
Il faut afficher ("C", "CS", "F", "H", "HS", "M", "O", "P", "RF", "VA/HS") dans la colonne O/F et la trier de A à Z.
J'ai fait ceci :

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("A3")) Is Nothing Then
 ActiveSheet.Name = Target: End If
 
 ActiveSheet.ListObjects("Tableau2").Range.AutoFilter Field:=4, Criteria1:= _
        Array("C", "CS", "F", "H", "HS", "M", "O", "P", "RF", "VA/HS"), Operator:= _
        xlFilterValues
    ActiveWorkbook.Worksheets("02-01-20").ListObjects("Tableau2").Sort.SortFields. _
        Clear
    ActiveWorkbook.Worksheets("02-01-20").ListObjects("Tableau2").Sort.SortFields. _
        Add2 Key:=Range("Tableau2[[#All],[O/F]]"), SortOn:=xlSortOnValues, Order _
        :=xlAscending, CustomOrder:="o,f,c,cs,hs,ss,rf,m,VA/HS", DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("02-01-20").ListObjects("Tableau2").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
End Sub

Je place ceci sur la feuille mais quand je fais une copie de la feuille pour faire un autre jour, le nom de feuille et du tableau ne change pas dans le code en fonction du nom de la feuille (nom de la feuille en A3).

Je ne sais pas si je suis explicite et si vous savez m'aider ?
Merci d'avance

CHALET53 · 28 Décembre 2019

Bonjour,

Peut-être quelque chose comme cela qui s'appliquera à toutes les feuilles
A placer dans Thisworkbook

J'ai repris ton code sans le modifier en supposant qu'il n'y avait pas d'anomalie

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not Application.Intersect(Target, Range("A3")) Is Nothing Then
ActiveSheet.Name = Target: End If

ActiveSheet.ListObjects("Tableau2").Range.AutoFilter Field:=4, Criteria1:= _
Array("C", "CS", "F", "H", "HS", "M", "O", "P", "RF", "VA/HS"), Operator:= _
xlFilterValues
ActiveWorkbook.Worksheets("02-01-20").ListObjects("Tableau2").Sort.SortFields. _
Clear
ActiveWorkbook.Worksheets("02-01-20").ListObjects("Tableau2").Sort.SortFields. _
Add2 Key:=Range("Tableau2[[#All],[O/F]]"), SortOn:=xlSortOnValues, Order _
:=xlAscending, CustomOrder:="o,f,c,cs,hs,ss,rf,m,VA/HS", DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("02-01-20").ListObjects("Tableau2").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub

A+

moi_ces_moi · 28 Décembre 2019

CHALET53 à dit:
Bonjour,

Peut-être quelque chose comme cela qui s'appliquera à toutes les feuilles
A placer dans Thisworkbook

J'ai repris ton code sans le modifier en supposant qu'il n'y avait pas d'anomalie

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not Application.Intersect(Target, Range("A3")) Is Nothing Then
ActiveSheet.Name = Target: End If

ActiveSheet.ListObjects("Tableau2").Range.AutoFilter Field:=4, Criteria1:= _
Array("C", "CS", "F", "H", "HS", "M", "O", "P", "RF", "VA/HS"), Operator:= _
xlFilterValues
ActiveWorkbook.Worksheets("02-01-20").ListObjects("Tableau2").Sort.SortFields. _
Clear
ActiveWorkbook.Worksheets("02-01-20").ListObjects("Tableau2").Sort.SortFields. _
Add2 Key:=Range("Tableau2[[#All],[O/F]]"), SortOn:=xlSortOnValues, Order _
:=xlAscending, CustomOrder:="o,f,c,cs,hs,ss,rf,m,VA/HS", DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("02-01-20").ListObjects("Tableau2").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub

A+

Le problème c'est que je vais créer plusieurs feuille avec des noms different et le tableau dans chaque feuille va avoir un nom different donc le code n'est plus bon.

merci pour la reponse

chris · 28 Décembre 2019

Bonjour à tous

Si, comme cela est la règle, tu ne laissais pas le nom automatique du tableau mais un nom signifiant, il serait alors très simple d'adapter le code

A défaut le nom du tableau est facile à obtenir à partir de
ActiveSheet.Range("A4").ListObject.Name
ou
ActiveSheet.ListObjects(1).Name

CHALET53 · 28 Décembre 2019

Bonjour Chris,
En utilisant ta proposition, ça peut se modifier comme suit :
Je ne mets pas en doute les actions codifiées dans ton code

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
a = ActiveSheet.Range("A4").ListObject.Name
b = ActiveSheet.Name
If Not Application.Intersect(Target, Range("A3")) Is Nothing Then
'ActiveSheet.Name = Target
End If

ActiveSheet.ListObjects(a).Range.AutoFilter Field:=4, Criteria1:= _
Array("C", "CS", "F", "H", "HS", "M", "O", "P", "RF", "VA/HS"), Operator:= _
xlFilterValues
ActiveWorkbook.Worksheets(b).ListObjects(a).Sort.SortFields. _
Clear
ActiveWorkbook.Worksheets(b).ListObjects(a).Sort.SortFields. _
Add2 Key:=Range("Tableau2[[#All],[O/F]]"), SortOn:=xlSortOnValues, Order _
:=xlAscending, CustomOrder:="o,f,c,cs,hs,ss,rf,m,VA/HS", DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets(b).ListObjects(a).Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub

a+

moi_ces_moi · 28 Décembre 2019

CHALET53 à dit:
Bonjour Chris,
En utilisant ta proposition, ça peut se modifier comme suit :
Je ne mets pas en doute les actions codifiées dans ton code

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
a = ActiveSheet.Range("A4").ListObject.Name
b = ActiveSheet.Name
If Not Application.Intersect(Target, Range("A3")) Is Nothing Then
'ActiveSheet.Name = Target
End If

ActiveSheet.ListObjects(a).Range.AutoFilter Field:=4, Criteria1:= _
Array("C", "CS", "F", "H", "HS", "M", "O", "P", "RF", "VA/HS"), Operator:= _
xlFilterValues
ActiveWorkbook.Worksheets(b).ListObjects(a).Sort.SortFields. _
Clear
ActiveWorkbook.Worksheets(b).ListObjects(a).Sort.SortFields. _
Add2 Key:=Range("Tableau2[[#All],[O/F]]"), SortOn:=xlSortOnValues, Order _
:=xlAscending, CustomOrder:="o,f,c,cs,hs,ss,rf,m,VA/HS", DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets(b).ListObjects(a).Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub

a+

Merci pour la réponse mais le code ne fonctionne pas !
Qu'est ce qui active le code ?
et la ligne Add2 Key:=Range("Tableau2[[#All],[O/F]]"), SortOn:=xlSortOnValues, Order _ çà veut dire que mon tableau doit s'appeler "Tableau2" ?

CHALET53 · 28 Décembre 2019

Dans la ligne de code, remplace :
Add2 Key:=Range("Tableau2[[#All],[O/F]]")
par
Add2 Key:=Range(a & "[[#All],[O/F]]")

et la suite derrière

moi_ces_moi · 28 Décembre 2019

CHALET53 à dit:
Dans la ligne de code, remplace :
Add2 Key:=Range("Tableau2[[#All],[O/F]]")
par
Add2 Key:=Range(a & "[[#All],[O/F]]")

et la suite derrière

on avance petit a petit. ça bog a la ligne "ActiveWorkbook.Worksheets(b).ListObjects(a).Sort.SortFields. _"

VB:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

 a = ActiveSheet.Range("A4").ListObject.Name
 b = ActiveSheet.Name
 If Not Application.Intersect(Target, Range("A3")) Is Nothing Then
 ActiveSheet.Name = Target
End If

ActiveSheet.ListObjects(a).Range.AutoFilter Field:=4, Criteria1:= _
Array("C", "CS", "F", "H", "HS", "M", "O", "P", "RF", "VA/HS"), Operator:= _
xlFilterValues
'ça bog la ligne en dessous
ActiveWorkbook.Worksheets(b).ListObjects(a).Sort.SortFields. _
Clear
ActiveWorkbook.Worksheets(b).ListObjects(a).Sort.SortFields. _
Add2 Key:=Range(a & "[[#All],[O/F]]"), SortOn:=xlSortOnValues, Order _
:=xlAscending, CustomOrder:="o,f,c,cs,hs,ss,rf,m,VA/HS", DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets(b).ListObjects(a).Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
 End Sub

Quand je change la date le code retire les ligne du tableau que je n'ai pas besoin mais ne les tries pas de A à Z ! bizzar

moi_ces_moi · 28 Décembre 2019

J'ai modifier le code comme ceci.

VB:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

 a = ActiveSheet.Range("A4").ListObject.Name
 b = ActiveSheet.Name
 If Not Application.Intersect(Target, Range("A3")) Is Nothing Then
 ActiveSheet.Name = Target
End If

ActiveSheet.ListObjects(a).Range.AutoFilter Field:=4, Criteria1:= _
Array("C", "CS", "F", "H", "HS", "M", "O", "P", "RF", "VA/HS"), Operator:= _
xlFilterValues
ActiveSheet.ListObjects(a).Sort.SortFields. _
Clear
ActiveSheet.ListObjects(a).Sort.SortFields. _
Add2 Key:=Range(a & "[[#All],[O/F]]"), SortOn:=xlSortOnValues, Order _
:=xlAscending, CustomOrder:="o,f,c,cs,hs,ss,rf,m,VA/HS", DataOption:= _
xlSortNormal
With ActiveSheet.ListObjects(a).Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
 End Sub

CHALET53 · 28 Décembre 2019

Si le résultat obtenu est celui que tu cherches, c'est parfait

moi_ces_moi · 28 Décembre 2019

CHALET53 à dit:
Si le résultat obtenu est celui que tu cherches, c'est parfait

Merci beaucoup pour ton aide

Faire fonctionner le filtre d'un tableau dans une feuille a chaque fois que je vais dessus

moi_ces_moi

XLDnaute Nouveau

Pièces jointes

CHALET53

XLDnaute Barbatruc

moi_ces_moi

XLDnaute Nouveau

chris

XLDnaute Barbatruc

CHALET53

XLDnaute Barbatruc

moi_ces_moi

XLDnaute Nouveau

CHALET53

XLDnaute Barbatruc

moi_ces_moi

XLDnaute Nouveau

moi_ces_moi

XLDnaute Nouveau

CHALET53

XLDnaute Barbatruc

moi_ces_moi

XLDnaute Nouveau

Discussions similaires