Comment conserver filtre dans classeur créé par macro

Le 31/01/2017 à 22:14

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.

Le 31/01/2017 à 23:11

Salut,

Le plus simple serait d'avoir ton fichier et ta macro à disposition

Cordialement.

Le 01/02/2017 à 21:19

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.

Le 01/02/2017 à 22:05

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.

Le 01/02/2017 à 22:07

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.

17donnees.xlsm (29.06 Ko)
Le 01/02/2017 à 23:30

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.

capture
10donnees-v1.xlsm (28.29 Ko)
Le 02/02/2017 à 06:39

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.

Le 02/02/2017 à 18:39

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.

Le 02/02/2017 à 19:08

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.

Le 02/02/2017 à 20:18

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.

Le 02/02/2017 à 20:30

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.

Le 02/02/2017 à 20:51

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.

Le 02/02/2017 à 20:57

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.

Le 02/02/2017 à 21:19

C'est bon j'ai réussi, merci quand même.

Le 02/02/2017 à 21:47

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.

Rechercher des sujets similaires à "comment conserver filtre classeur cree macro"