Macro perturbe filtre
Bonjour,
Je rencontre un problème !
Lorsque j'exécute ma macro, les filtres que j'avais mis en place ne sont plus effectifs.
De ce fait, j'aimerai modifier mon code VBA de manière à ce que l’exécution de ma macro ne perturbe pas le fonctionnement des filtres mis en place.
Option Explicit
Public Sub cmdCreateWorksheets_Click()
'Declaration des variables
Dim ws As Worksheet, ws2 As Worksheet, WSnew As Worksheet
Dim lo As ListObject, lo2 As ListObject
Dim Cell As Range
Dim lRow As Long
'Optimisation du code
With Application
.DisplayAlerts = False
'.EnableEvents = False
.ScreenUpdating = False
End With
'Suppression des feuilles sauf la feuille active (feuille Donnees)
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> "données" And ws.Name <> "TCD" Then ws.Delete
'If ws.Name <> ActiveSheet.Name Then ws.Delete
Next ws
'Initialisation des varialbes
Set ws = ActiveSheet 'Feuilles Donnees
Set lo = ws.ListObjects(1) 'Tableau feuille Données (Excel 2007+)
If lo.ShowAutoFilter Then
If lo.AutoFilter.FilterMode Then lo.AutoFilter.ShowAllData
Else
lo.ShowAutoFilter = True
End If
'Creation feuille temporaire (qui sera supprimée en fin de procédure)
'La feuille va recevoir la liste des valeurs uniques de la colonne 8 (Field Num)
Set ws2 = ActiveWorkbook.Worksheets.Add
With ws2
lo.ListColumns(6).Range.AutoFilter field:=6, Criteria1:="<>"
lo.ListColumns(9).Range.AutoFilter field:=9, Criteria1:="<>"
lo.ListColumns(9).Range.AutoFilter field:=10, Criteria1:="="
lo.ListColumns(8).DataBodyRange.SpecialCells(xlCellTypeVisible).Copy
.Cells(1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
.Cells(1).CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlNo
'Nombre de valeurs uniques du filtre avancé
lRow = .Cells(Rows.Count, 1).End(xlUp).Row
'Pour chaque élément de la liste unique (Edition)
For Each Cell In .Range("A1:A" & lRow)
'On effectue le filtrage suivant l'item
lo.Range.AutoFilter field:=8, Criteria1:="=" & Cell.Value
'On crée la nouvelle feuille qui va recevoir les données filtrées
Set WSnew = ActiveWorkbook.Worksheets.Add(after:=Worksheets(Worksheets.Count))
'On nomme la nouvelle feuille avec la valeur de l'élément
WSnew.Name = IIf(Len(Cell) > 31, Left(Cell, 20) & "...." & Right(Cell, 7), Cell.Value)
'On copie la plage filtrée (tableau feuille Données)
lo.Range.SpecialCells(xlCellTypeVisible).Copy
With WSnew
With .Cells(1)
.PasteSpecial xlPasteColumnWidths
.PasteSpecial xlPasteValuesAndNumberFormats
End With
Application.CutCopyMode = False
.Columns("L:N").Delete Shift:=xlToLeft
.Columns("A:E").Delete Shift:=xlToLeft
'On crée un nouveau tableau (Excel 2007+)
Set lo2 = .ListObjects.Add(xlSrcRange, WSnew.Cells(1).CurrentRegion, , xlYes)
With lo2
'On détermine le style du tableau
.TableStyle = "TableStyleLight1"
.ShowTotals = True
.ListColumns(5).TotalsCalculation = xlTotalsCalculationSum
End With
'Ono active la nouvelle feuille la mise en forme (minimale)
.Activate
.Cells(1).Select
ActiveWindow.DisplayGridlines = False
End With
Next Cell
End With
lo.AutoFilter.ShowAllData
'On supprime la feuille temporaire
ws2.Delete
'On active la feuille Données
ws.Activate
MsgBox "Terminé"
With Application
.DisplayAlerts = True
'.EnableEvents = True
End With
'On réinitialise les variables (on vide la mémoire)
Set lo = Nothing
Set WSnew = Nothing: Set ws2 = Nothing: Set ws = Nothing
End SubBien à vous,
Bonsoir,
Lorsque j'exécute ma macro, les filtres que j'avais mis en place ne sont plus effectifs.
Il serait utile que tu précises ce que tu entends par là (sans oublier de localiser les filtres en question).
Bonsoir,
Le filtre est appliqué à la 8ème colonne, la H, relative au nom de l'Edition concernée.
J'applique un filtre afin de voir uniquement les données relatives aux editions m'intéressant (sinon, je me retrouve avec plus de 1000lignes !...)
Je suppose qu'en fin de macro on réaffiche toutes les lignes (ShowAllData). Il te faut donc à la place réactiver le filtrage qui te convient.
Oui, c'est exact.
Comment pourrai-je y procéder ?
En le rétablissant ! C'est toi qui sait quel filtrage tu veux. Il n'y en a pas mention dans la macro.
Je veux simplement que la macro ne touche pas au filtre que j'ai mis en place
A mon avis, alors il faut la supprimer...
J'ai essayé mais cela ne fonctionne pas
Je vous joins mon fichier afin que vous puissiez davantage comprendre !
A voir.
J'ai remplacé
Array("A", "C", "D", "E", "F", "H"), Operator:=xlFilterValuespar mes véritables valeurs mais, étrangement, cela ne fonctionne pas... Après exécution de la macro, seules les données "entre guillemets", que j'ai filtré apparaissent. Or, c'est exactement le contraire que je souhaite haha
Tu as mis un fichier, filtré !
J'ai rétabli ce filtrage en fin de ta macro.
Si tu ne sais plus ce que tu veux, c'est un autre problème.
Je sais ce que je veux. Le soucis étant que je ne sais pas expliciter mes besoins haha !
Je mets en place un filtre afin de masquer certaines données.
Lors de l’exécution de la macro, le filtre disparaît et les données que je souhaitait masquer réapparaissent.
Or, je souhaite qu'elles restent masquées après l’exécution de la macro (sinon, je me retrouve avec un tableau à plus de 1000lignes!)
Tu ne lis pas ce qui précède !
Bien évidemment que si MFerrand !
Tu parles de ceci ?
lo.AutoFilter.ShowAllData
lo.Range.AutoFilter Field:=8, Criteria1:= _
Array("A", "C", "D", "E", "F", "H"), Operator:=xlFilterValuesMFerrand a écrit :Tu as mis un fichier, filtré !
J'ai rétabli ce filtrage en fin de ta macro.
Si tu ne sais plus ce que tu veux, c'est un autre problème.
Et de ceci.
Et ? Je l'ai bien vu mais, je ne vois toujours pas où tu veux en venir
Ce filtrage est bien rétabli en fin de macro !
Donc le problème devrait être résolu depuis longtemps.
Je pense qu'il y a un problème de communication haha...
Je ne comprends vraiment pas ce que tu veux dire par là
Bonjour fatm_blk,
Bonjour MFerrand,
La demande n'est pas claire, dans la mesure ou à l'origine il n'y pas de filtre.
J'interviens car je suis à l'origine de cette procédure.
J'ai revu celle-ci et ajouté en fin le choix de conserver ou pas certains filtres (partie surlignée)
Dans l'exemple, on conserve tous les filtres sauf le filtre Edition.
A adapter donc!
Cdlt.
Option Explicit
Public Sub cmdCreateWorksheets_Click()
'Declaration des variables
Dim ws As Worksheet, ws2 As Worksheet, WSnew As Worksheet
Dim lo As ListObject, lo2 As ListObject
Dim Cell As Range
Dim lRow As Long
'Optimisation du code
With Application
.DisplayAlerts = False
'.EnableEvents = False
.ScreenUpdating = False
End With
'Suppression des feuilles sauf la feuille active (feuille Donnees)
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> ActiveSheet.Name Then ws.Delete
Next ws
'Initialisation des variabes
Set ws = ActiveSheet 'Feuilles Donnees
Set lo = ws.ListObjects(1) 'Tableau feuille Donnees (Excel 2007+)
'Si le filtre automatique est affiche
If lo.ShowAutoFilter Then
'Si le tableau est en mode AutoFilter, on affiche toutes les donnees
If lo.AutoFilter.FilterMode Then lo.AutoFilter.ShowAllData
Else
'Si le filtre automatique n'est pas affiche, on affiche le filtre automatique
lo.ShowAutoFilter = True
End If
'Creation feuille temporaire (qui sera supprimee en fin de procedure)
'La feuille va recevoir la liste des valeurs uniques de la colonne 8)
Set ws2 = ActiveWorkbook.Worksheets.Add
With ws2
lo.Range.AutoFilter field:=6, Criteria1:="<>" 'date de publication
lo.Range.AutoFilter field:=9, Criteria1:="<>" 'facture total
lo.Range.AutoFilter field:=10, Criteria1:="=" 'commission
lo.ListColumns(8).DataBodyRange.SpecialCells(xlCellTypeVisible).Copy 'Edition
.Cells(1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
.Cells(1).CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlNo
'Nombre de valeurs uniques du filtre avance
lRow = .Cells(Rows.Count, 1).End(xlUp).Row
'Pour chaque element de la liste unique (Edition)
For Each Cell In .Range("A1:A" & lRow)
'On effectue le filtrage suivant l'element
lo.Range.AutoFilter field:=8, Criteria1:="=" & Cell.Value
'On cree la nouvelle feuille qui va recevoir les donnees filtrees
Set WSnew = ActiveWorkbook.Worksheets.Add(after:=Worksheets(Worksheets.Count))
'On nomme la nouvelle feuille avec la valeur de l'element
WSnew.Name = Cell.Value
'On copie la plage filtree (tableau feuille Donnees)
lo.Range.SpecialCells(xlCellTypeVisible).Copy
With WSnew
With .Cells(1)
.PasteSpecial xlPasteColumnWidths
.PasteSpecial xlPasteValuesAndNumberFormats
End With
Application.CutCopyMode = False
.Columns("A:E").Delete shift:=xlToLeft
'On cree un nouveau tableau (Excel 2007+)
Set lo2 = .ListObjects.Add(xlSrcRange, WSnew.Cells(1).CurrentRegion, , xlYes)
With lo2
'On determine le style du tableau
.TableStyle = "TableStyleLight1"
'On affiche la ligne des totaux
.ShowTotals = True
'On calcule la somme de la colonne 5 (Commission)
.ListColumns(5).TotalsCalculation = xlTotalsCalculationSum
End With
'On active la nouvelle feuille et on effectue la mise en forme (minimale)
.Activate
.Cells(1).Select
'L'affichage du quadrillage est desactive
ActiveWindow.DisplayGridlines = False
End With
Next Cell
End With
'On affiche toutes les donnees du tableau
'lo.AutoFilter.ShowAllData
'Ou on efface les filtres pour les colonnes (choix)
'Inibher la (les) ligne(s) inutile(s)
'lo.Range.AutoFilter field:=6 'date de publication
lo.Range.AutoFilter field:=8 'Edition
'lo.Range.AutoFilter field:=9 'facture total
'lo.Range.AutoFilter field:=10 'commission
'On supprime la feuille temporaire
ws2.Delete
'On active la feuille Donnees
ws.Activate
MsgBox "Terminé"
With Application
.DisplayAlerts = True
'.EnableEvents = True
End With
'On reinitialise les variables (on vide la memoire)
Set lo2 = Nothing: Set lo = Nothing
Set WSnew = Nothing: Set ws2 = Nothing: Set ws = Nothing
End Sub