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

M

moi_ces_moi

XLDnaute Nouveau
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
 

Pièces jointes

  • feuille journaliere.xlsm
    31.1 KB · Affichages: 4
Trier par date Trier par votes
C

CHALET53

XLDnaute Barbatruc
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+
 
Vote positif 0 Vote négatif
M

moi_ces_moi

XLDnaute Nouveau
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+
Cliquez pour agrandir...

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
 
Vote positif 0 Vote négatif
chris

chris

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif
C

CHALET53

XLDnaute Barbatruc
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+
 
Vote positif 0 Vote négatif
M

moi_ces_moi

XLDnaute Nouveau
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+
Cliquez pour agrandir...
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" ?
 
Vote positif 0 Vote négatif
M

moi_ces_moi

XLDnaute Nouveau
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
Cliquez pour agrandir...
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
 
Vote positif 0 Vote négatif
M

moi_ces_moi

XLDnaute Nouveau
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
 
Vote positif 0 Vote négatif

Discussions similaires

C
  • Résolu(e)
Microsoft 365 Créer un RV outlook à partir de chaque ligne d'un tableau
Réponses
8
Affichages
729
c.branco
C
J
  • Question
XL 2019 probleme Sheets("entreeor").ListObjects(1).ListRows.Add
Réponses
11
Affichages
935
Gégé-45550
Gégé-45550
zayab
  • Résolu(e)
XL 2016 Dupliquer une feuille contenant un tableau anonyme trié par vba
Réponses
4
Affichages
696
zayab
zayab
S
  • Question
Microsoft 365 Réduire macro "Tri" suite enregistreur macro
Réponses
11
Affichages
1 K
soan
S
U
  • Résolu(e)
Autres Mettre en couleur ligne avec VBA car MFC occupées (Excel 2003)
2
Réponses
15
Affichages
1 K
un internaute
U
U
  • Question
Autres {RÉSOLU] Problème macro
Réponses
2
Affichages
521
un internaute
U
P
  • Question
XL 2019 VBA Erreur d'exécution "9" dans une plage de tableau
Réponses
2
Affichages
319
piskely
P
A
  • Question
XL 2013 Macro pour copier des colonne d'une feuille A dans un classeur sur une feuille B dans un autre classeur .
Réponses
7
Affichages
967
Hasco
Hasco
B
  • Question
Microsoft 365 VBA Compter 2 lignes après la fin d'un tableau dont on a le nom
Réponses
2
Affichages
681
bluesky12000
B
A
  • Résolu(e)
Autres Mettre une alerte si la textbox n'est pas remplie
17 18 19
Réponses
280
Affichages
15 K
patricktoulon
patricktoulon

Membres actuellement en ligne

17 membres et 331 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 169
Messages
2 085 922
Membres
103 040
dernier inscrit
badi