Comment conserver filtre dans classeur créé par macro
Bonjour,
Ma macro génère un nouveau classeur dans lequel le filtre (en tête de colonne) est désactivé alors que dans mon classeur source où se trouve la macro j'ai bien le filtre actif.
Que faire dans ma macro pour que ce filtre soit conservé?
Merci.
Salut,
Le plus simple serait d'avoir ton fichier et ta macro à disposition
Cordialement.
Bonsoir,
Merci d'essayer de m'aider.
Ce n'est pas facile d'envoyer mon fichier car il contient des données pro, mais voici ma macro:
Option Explicit
Const Dossier_Global = "F:\Prestations"
Sub Enreg_classeur()
Dim Fichier As String, Feuille As String, dlig As Long
Dim Dossier_Clients As String
Dim Feuille_Existe As Boolean
Dossier_Clients = Dossier_Global & "\" & [B1]
If Dir(Dossier_Clients, vbDirectory) = "" Then MkDir Dossier_Clients
Fichier = Dossier_Clients & "\" & [B5] & ".xlsx": Feuille = [B6]
If Dir(Fichier) = "" Then
' Le fichier n'existe pas => on le crée (1 seule feuille, sur laquelle on est)
' -4167 => création d'un nouveau classeur avec une feuille de calcul vierge
Workbooks.Add -4167: ActiveWorkbook.Author = ""
Else
' Le fichier existe => on l'ouvre, puis on essaye d'aller sur la feuille B6 ;
' si pas d'erreur : on est dessus ; sinon : on ajoutera 1 feuille en dernier
Workbooks.Open Fichier
On Error Resume Next
Err.Clear
Worksheets(Feuille).Select
If Err Then
Worksheets.Add , Worksheets(Worksheets.Count)
Feuille_Existe = False
Else
Feuille_Existe = True
End If
End If
' Effacement de la liste précédemment copiée (selon filtre) déjà existante ;
' ainsi, si la nouvelle liste copiée est moins longue, les lignes en plus
' de la précédente liste n'apparaîtront pas
dlig = [A1].CurrentRegion.Rows.Count
If dlig > 1 Then Range("A1:F" & dlig).ClearContents
With ThisWorkbook
With .Worksheets("Liste")
.[A1].CurrentRegion.SpecialCells(xlCellTypeVisible).Copy [A2]
Columns("A:C").ColumnWidth = 60
Columns("D:E").ColumnWidth = 20
Columns("F:F").ColumnWidth = 40
End With
With .Worksheets("Prestation")
ActiveSheet.Name = .[B6]
End With
End With
Dim Image_Logo As String
Dim Largeur_Logo As Long
Dim ShapeLeft As Long
Dim Image_Client As String
Rows(1).Interior.Color = RGB(255, 255, 255)
' PARAMETRE : ******************* HAUTEUR DES LIGNES 2 à X *******************
ActiveSheet.UsedRange.Rows.RowHeight = 30
' PARAMETRE : ******************* HAUTEUR DE LA PREMIERE LIGNE *******************
Rows(1).RowHeight = 205
Columns("A:A").ColumnWidth = ThisWorkbook.Sheets("Liste").Columns("A:A").ColumnWidth
Columns("B:B").ColumnWidth = ThisWorkbook.Sheets("Liste").Columns("B:B").ColumnWidth
Columns("C:C").ColumnWidth = ThisWorkbook.Sheets("Liste").Columns("C:C").ColumnWidth
If Feuille_Existe = False Then
Image_Logo = Dossier_Global & "\Logos\Logo.jpg"
With ActiveSheet.Pictures.Insert(Image_Logo)
With .ShapeRange
.LockAspectRatio = msoTrue
' PARAMETRE : ******************* LARGEUR DE "MON LOGO" *******************
.Width = 200
End With
.Left = ActiveSheet.Cells(1, 1).Left
.Top = ActiveSheet.Cells(1, 1).Top
.Placement = 3
.PrintObject = True
End With
Image_Client = Dossier_Global & "\Logos\Logo " & ThisWorkbook.Worksheets("Prestation").[B1] & ".jpg"
With ActiveSheet.Pictures.Insert(Image_Client)
With .ShapeRange
.LockAspectRatio = msoTrue
.Width = 200
' PARAMETRE : ******************* LARGEUR DU LOGO CLIENT (ALIGNE A DROITE DU TABLEAU) *******************
Largeur_Logo = .Width
End With
.Left = ActiveSheet.Cells(1, 7).Left - Largeur_Logo - 1
.Top = ActiveSheet.Cells(1, 6).Top
.Placement = 3
.PrintObject = True
End With
ShapeLeft = (ActiveSheet.Columns("A:F").Width / 2) - 115
ActiveSheet.Shapes.AddShape(msoShapeRectangle, ShapeLeft, 18, 230, 72).Select
Selection.ShapeRange.Fill.Visible = msoFalse
Selection.ShapeRange.Line.Visible = msoFalse
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Feuille & vbCrLf & vbCrLf & ThisWorkbook.Sheets("Prestation").[B5]
Selection.ShapeRange(1).TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignLeft
Selection.ShapeRange(1).TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignCenter
With Selection.ShapeRange(1).TextFrame2.TextRange.Font.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 0, 0)
.Transparency = 0
.Solid
End With
With ActiveSheet.PageSetup
.Orientation = xlLandscape
.FitToPagesWide = 1
' .FitToPagesTall = 0
.Zoom = False
End With
Else: End If
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Fichier
Application.DisplayAlerts = True
ActiveSheet.PageSetup.PrintArea = ActiveSheet.Range("A1:F" & ActiveSheet.UsedRange.Rows.Count)
End Sub
Ma macro ne remet pas le filtre actif dans les les têtes de colonne sur la nouvelle pagé créée par la macro.
J'aimerais que le filtre suive.
Merci.
Re,
Tu crées une copie de ton fichier avec des données sensibles, tu effaces les 10'000 noms qu’il contient et tu inscrits 10 lignes représentatives en écrivant par exemple ‘’Nom 1’’ dans la colonne des noms et en incrémentant cette donnée vers le bas. Ainsi j’ai à disposition un fichier avec les bonnes feuilles, les bonnes colonnes, les bonnes lignes, les bons noms, etc. et je peux mieux t’aider.
J’ai tenté d’étudier ta macro sur la base d’une fichier Excel vierge, mais c’est la galère, chaque deux lignes je me rends compte qu’il y a quelque chose qui manque.
Amicalement.
OK je te prépare ça de suite.
Voici le fichier, tu vas peut être avoir des bugs par ce qu'il manque encore des fichiers, mais j'espère que ça suffira pour m'aider.
Salut,
Sur la base de ton fichier ‘’Données’’, j’ai créé le fichier ‘’Données_V1’’ ci-joint.
J’ai dû neutraliser toutes les lignes concernant ton logo, mais je ne pense pas que ce soient celles-ci qui créent problème.
J’ai ensuite modifié ta variable ‘’ Const Dossier_Global’’ de manière à ce que ça fonctionne sur ma machine et j’ai lancé ta macro.
Les filtres en place sur ta feuille de base le sont toujours dans le nouveau fichier créé par ta macro, comme tu peux le constater sur l’image ci-dessous. Je ne peux donc pas t’aider, puisque je n’ai pas les problèmes que tu indiques !! Désolé !
Peux-tu fournir une explication plus précise de ton problème, avec exemples et tutti quanti ?
Cordialement.
Bonjour,
Merci pour ton aide, mais je ne vois pas où est ta modif dans la macro V1.
Oui en effet chez moi ça fonctionne aussi lorsque tu ne filtre rien sur le fichier source, par contre dès que tu filtres dans la colonne A du fichier source, le filtre n'apparait plus dans le nouveau classeur créé.
Merci.
Salut,
guillaume7684 a écrit :mais je ne vois pas où est ta modif dans la macro V1
Je ne sais pas ce qu'il te faut
Tout d'abord j'ai modifié le chemin
'Const Dossier_Global = "F:\Prestations traiteurs"
Const Dossier_Global = "C:\Users\lacy\Documents\Provioire"
Puis j’ai neutralisé une très grande quantité de lignes :
.......................................
If Feuille_Existe = False Then
'' Image_Logo = Dossier_Global & "\Logos\Logo Morgan Services.jpg"
'' With ActiveSheet.Pictures.Insert(Image_Logo)
'' With .ShapeRange
'' .LockAspectRatio = msoTrue
'' ' PARAMETRE : ******************* LARGEUR DE "MON LOGO" *******************
'' .Width = 200
''
'' End With
'' .Left = ActiveSheet.Cells(1, 1).Left
'' .Top = ActiveSheet.Cells(1, 1).Top
'' .Placement = 3
'' .PrintObject = True
'' End With
''
'' Image_Client = Dossier_Global & "\Logos\Logo " & ThisWorkbook.Worksheets("Prestation").[B1] & ".jpg"
'' With ActiveSheet.Pictures.Insert(Image_Client)
'' With .ShapeRange
'' .LockAspectRatio = msoTrue
'' .Width = 200
'' ' PARAMETRE : ******************* LARGEUR DU LOGO CLIENT (ALIGNE A DROITE DU TABLEAU) *******************
'' Largeur_Logo = .Width
''
'' End With
'' .Left = ActiveSheet.Cells(1, 7).Left - Largeur_Logo - 1
'' .Top = ActiveSheet.Cells(1, 6).Top
'' .Placement = 3
'' .PrintObject = True
'' End With
''
' ShapeLeft = (ActiveSheet.Columns("A:F").Width / 2) - 100
'
' ActiveSheet.Shapes.AddShape(msoShapeRectangle, ShapeLeft, 18, 230, 72).Select
' Selection.ShapeRange.Fill.Visible = msoFalse
' Selection.ShapeRange.Line.Visible = msoFalse
' Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Font.Bold.Text = Feuille & vbCrLf & vbCrLf & ThisWorkbook.Sheets("Prestation").[B5]
'
' Selection.ShapeRange(1).TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignLeft
' Selection.ShapeRange(1).TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignCenter
'
'
' With Selection.ShapeRange(1).TextFrame2.TextRange.Font.Fill
' .Visible = msoTrue
' .ForeColor.RGB = RGB(0, 0, 0)
' .Transparency = 10
' .Solid
' End With
With ActiveSheet.PageSetup
.Orientation = xlLandscape
.FitToPagesWide = 1
' .FitToPagesTall = 0
.Zoom = False
End With
.........................................
J’ai repris ce fichier et j’ai filtré des données sur la feuille ‘’Liste’’ avant de lancer ton code. A la fin de la macro, dans le nouveau fichier créé, je n’ai effectivement plus de filtres en place, mais je n’ai que les données filtrées qui apparaissent, ce qui n’est pas dit clairement dans ta description. On pourrait penser, selon tes explications, que toutes les données sont reportées et que les filtres ont disparus.
Quel est donc ton désir : que tu retrouves sur ton fichier nouvellement créé toutes tes données avec certaines filtrées de la même manière que sur l’original ??
A te relire.
Je m'excuse si je me suis mal exprimé.
En fait j'aimerais encore avoir accès au filtre pour modifier les éléments de la colonne A même dans la feuille créée.
Merci.
Re,
Par ton instruction ci-dessous, tu ne copies et ne colles que les données visibles de ta feuille ‘’Liste’’.
.[A1].CurrentRegion.SpecialCells(xlCellTypeVisible).Copy [A2]
Tu devrais donc la remplacer par l’instruction ci-dessous qui copie et colle toutes tes données et laisse les filtres en place dans la ligne 2 du nouveau fichier.
.[A1].CurrentRegion.Copy [A2]
Par contre, avec cette solution, tes données sur le nouveau fichier ne sont plus filtrées comme sur le fichier de base. Une de mes questions – à laquelle tu n’as pas répondu – était : faut-il que les données filtrées à la base le soient dans le fichier créé ?
Amicalement.
Oui il faut que les données filtrées soient identiques entre la feuille source et la nouvelle feuille créée.
On y est presque !!!!
Pour être plus précis, je souhaiterais avoir le même affichage sur les 2 feuilles, filtre actif et modifiable quand sur la feuille source.
Re,
Je trouve ta manière de communiquer assez spécial, peu précise et quelque peu vexante.
Je t’ai posé des questions auxquelles tu n’as pas répondu.
Je te propose maintenant une solution pour laquelle tu ne dis pas si ça te convient en partie ou non ! As-tu testé ma dernière proposition et – si oui – te convient-elle ?
Après cette réponse, je lirai ton dernier message.
Chaleureusement.
Oui ton code fonctionne très bien et je t'en remercie.
Le filtre est bien actif, il me manque juste les données qui ne sont plus filtrées.
Merci pour ton aide.
C'est bon j'ai réussi, merci quand même.
Re,
Ca fait une demi-heure que je cherche une solution pour toi sur la toile et je me rends compte que le problème est assez conséquent. Je serais donc très intéressé à connaitre ta solution afin de pouvoir en profiter. Peux-tu me la fournir sous la forme d'un fichier Excel, s'il-te-plait ?
Amicalement.