Exporter un filtre en masquant certaines Colonnes

Bonsoir à tous sur le forum et merci de l'aide que je reçois chaque fois que je publie ici

Après avoir parcouru le forum une fois de plus, j'ai pu trouver un problème résolvant les filtres sur tableau. Mais, mon problème est celui d'exporter le filtre en feuille 3 en masquant 2 colonnes (ordonnateur et Concerné).

j'ai joints un essai et tiré d'ici et souhaiterais que quelqu'un m'aide à compléter.

Merci!!!!

Bonjour,

Une première proposition à adapter en fonction de tes besoins.

A te relire.

Cdlt.

Public Sub Trier()
Dim ws As Worksheet, wsd As Worksheet
Dim rng As Range, rngF As Range
Dim lo As ListObject

    Application.ScreenUpdating = False

    Set ws = ActiveSheet
    Set wsd = Worksheets("Feuil3")

    With wsd
        .Cells.Clear
        .[A1:C1] = Array("DATE", "MOTIF", "MONTANT")
    End With

    With ws
        If .FilterMode = True Then .ShowAllData
        Set rng = .Range("Tableau1[[#Headers],[#Data]]")

        On Error Resume Next
        With rng
            .AdvancedFilter _
                Action:=xlFilterInPlace, _
                CriteriaRange:=Range("Criteres"), _
                Unique:=False
            Set rngF = _
                .Offset(1, 0).Resize(.Rows.Count - 1, 3).SpecialCells(xlCellTypeVisible)
        End With
        On Error GoTo 0

        If rngF Is Nothing Then
            MsgBox "Aucunes données correspondantes aux critères."
            .ShowAllData
            Exit Sub
        End If

        rngF.Copy
        wsd.Cells(2, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        Application.CutCopyMode = False
    End With

    wsd.Activate

    With wsd
        Set lo = .ListObjects.Add(xlSrcRange, Cells(1, 1).CurrentRegion, , xlYes)
        With lo
            .Name = "Tableau2"
            .TableStyle = "TableStyleLight9"
            .ShowTotals = True
            .ListColumns("MONTANT").TotalsCalculation = xlTotalsCalculationSum
        End With
        .[A1].Select
        .[A1:C1].EntireColumn.AutoFit
    End With

    Set ws = Nothing: Set wsd = Nothing
    Set rng = Nothing: Set rngF = Nothing
    Set lo = Nothing

End Sub

Jean-Eric

Bonjour!

Je te suis très reconnaissante pour la prompte réaction et ce code VBA que je trouve complexe et j'apprécie par conséquent le temps que cela t'a pris.

Cela la répond à mes souhaits, j'ai toutefois 2 autres préoccupations s'il te plaît:

Mais je souhaiterais que:

1) Le collage du filtre de se fasse à la fin d'un autre tableau qui sera en feuille 3, en sautant une ligne.

2) Et que lors de l'initialisation du filtre, le filtre exporté soit aussi effacé (Supprimé)

Merci et agréable journée à toi et tous ceux qui s'efforcent encore.

Bonjour,

1 - Pas de souci particulier pour modifier le code en conséquence. Mais pourquoi insérer une ligne entre 2 exports?

Tu auras remarqué la création d'un nouveau tableau en Feuil3. Que devient-il? Est-il utile?

*Les tableaux n'apprécient guère des lignes vides.

2 - Je ne comprends pas :

Et que lors de l'initialisation du filtre, le filtre exporté soit aussi effacé (Supprimé)

Peux-tu donc préciser tes attentes? Avec l'envoi d'un nouveau fichier et exemples de mise en forme (Feuil3)

Cdlt.

1 - Pas de souci particulier pour modifier le code en conséquence. Mais pourquoi insérer une ligne entre 2 exports?

Tu auras remarqué la création d'un nouveau tableau en Feuil3. Que devient-il? Est-il utile?

*Les tableaux n'apprécient guère des lignes vides.

2 - Je ne comprends pas :

Je me suis petêtre mal exprimée!

c'est que en réalité, le filtre effectué vient se poser sous un autre tableau en Feuil3, puis, lors de la réinitialisation (ShowAllData), le tableau qui venait d'être créé (en filtre) se supprimes.

j'ai pensé à cette option pour le problème n°2

Sub Initianliser()
If FilterMode then ShowAllData
range("Tableau2").Delete
End sub

Je ne sais si je me suis expliquée.

et pour le 1er problème jai pensé à une formule Offset(x,y)

Merci beaucoup!

Bonjour,

Nouvelle proposition sans savoir ou copier la plage filtrée en Feuil3 et sans connaître la structure de cette feuille

A te relire.

Cdlt.

Public Sub Trier()
Dim ws As Worksheet, wsd As Worksheet
Dim rng As Range, rngF As Range
Dim lo As ListObject

    Application.ScreenUpdating = False

    Set ws = ActiveSheet
    Set wsd = Worksheets("Feuil3")

    With wsd
        On Error Resume Next
       .Range("Tableau2[#All]").Clear
       On Error GoTo 0
    End With

    With ws
        If .FilterMode = True Then .ShowAllData
        Set rng = .Range("Tableau1[[#Headers],[#Data]]")

        On Error Resume Next
        With rng
            .AdvancedFilter _
                Action:=xlFilterInPlace, _
                CriteriaRange:=Range("Criteres"), _
                Unique:=False
            Set rngF = .Resize(.Rows.Count - 1, 3).SpecialCells(xlCellTypeVisible)
        End With
        On Error GoTo 0

        If rngF Is Nothing Then
            MsgBox "Il n'y a pas de données correspondantes aux critères."
            .ShowAllData
            Exit Sub
        End If

        rngF.Copy
        wsd.Cells(1, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        Application.CutCopyMode = False

       .ShowAllData

    End With

    wsd.Activate

    With wsd
        Set lo = .ListObjects.Add(xlSrcRange, Cells(1, 1).CurrentRegion, , xlYes)
        With lo
            .Name = "Tableau2"
            .TableStyle = "TableStyleLight9"
            .ShowTotals = True
            .ListColumns("MONTANT").TotalsCalculation = xlTotalsCalculationSum
        End With
        .[A1].Select
        .[A1:C1].EntireColumn.AutoFit
    End With

    Set ws = Nothing: Set wsd = Nothing
    Set rng = Nothing: Set rngF = Nothing
    Set lo = Nothing

End Sub

Bonjour Jean-Eric, et les autres qui suivent le déroulement du traitement de mon problème et en profitent.

Merci pour les efforts, mais j'ai du mal à comprendre le code VBA, tout au fond de moi je me dis que cela va marcher.

STP, peux-tu réécrire ce code en insérant juste les explications afin que je puisse mieux l'adapter? du genre ce code veut dire

'suppression des colonnes non nécessaire lors du filtre. bref les explictions.

Merci beaucoup!

Jean-Eric

Re,

A te relire.

Si cela satisfait ta demande, je renvoie le fichier avec ses commentaires.

Mais je ne peux pas commenter toute la procédure.

A te relire sur des points spécifiques.

Cdlt.

Public Sub Trier()
' déclaration des variables
Dim ws As Worksheet, wsd As Worksheet
Dim rng As Range, rngF As Range
Dim lo As ListObject
    ' optimisation procédure
    ' *** double clic sur ScreenUpdating affiche l'aide - valable pour l'ensemble des fonctions, méthodes
    ' et propriétés
    Application.ScreenUpdating = False
    ' initialisation des variables objets
    Set ws = ActiveSheet    ' Feuille Dépenses
    Set wsd = Worksheets("Feuil3")
    ' suppression Tableau2 correspond à l'ancienne plage filtrée
    With wsd
        On Error Resume Next
        .Range("Tableau2[#All]").Clear
        On Error GoTo 0
    End With
    ' création filtre suivant critères définis et copie données filtrées
    With ws
        ' si filtre dans feuille, efface le filtre
        If .FilterMode = True Then .ShowAllData
        ' on définit la plage du tableau
        Set rng = .Range("Tableau1[[#Headers],[#Data]]")
        'Set rng = .Range("Tableau1[#All]") ' alernative pour la sélection
        On Error Resume Next
        ' filtrage suivant critères définis
        With rng
            .AdvancedFilter _
                Action:=xlFilterInPlace, _
                CriteriaRange:=Range("Criteres"), _
                Unique:=False
            ' définition de la plage filtrée avec les entêtes de colonnes
            ' 3 = colonnes A ---> C
            Set rngF = .Resize(.Rows.Count - 1, 3).SpecialCells(xlCellTypeVisible)
        End With
        On Error GoTo 0
        ' pas de données correspondantes aux critères - on quitte la procédure
        If rngF Is Nothing Then
            MsgBox "Il n'y a pas de données correspondantes aux critères."
            .ShowAllData
            Exit Sub
        End If
        ' dans le cas contraire, copie de la plage filtrée avec entêtes de colonnes
        rngF.Copy
        ' pour l'exemple Feuil3 cellule A1 pour la recopie
        wsd.Cells(1, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        Application.CutCopyMode = False
        ' suppression filtre Tableau1
        .ShowAllData

    End With
    ' activation Feuil3
    wsd.Activate

    With wsd
        ' initialisation objet tableau2 (plage filtrée)
        Set lo = .ListObjects.Add(xlSrcRange, Cells(1, 1).CurrentRegion, , xlYes)
        ' mise en forme Tableau2 (plage filtrée)
        With lo
            .Name = "Tableau2"
            .TableStyle = "TableStyleLight9"
            .ShowTotals = True
            .ListColumns("MONTANT").TotalsCalculation = xlTotalsCalculationSum
        End With
        .[A1].Select
        ' largeur colonnes auto
        .[A1:C1].EntireColumn.AutoFit
    End With
    ' on réinitialise les variables objets (on libère la mémoire utilisée)
    Set ws = Nothing: Set wsd = Nothing
    Set rng = Nothing: Set rngF = Nothing
    Set lo = Nothing

End Sub

Jean-Eric

Merci beaucoup!

Une dernière question:

Si les colonnes à masquer lors du filtre sont dispersées en désordre c-à-d

On doit supprimer la colonne C, E, G par exemple, comment ajuster sur le code que tu as écrit. Je ne parviens pas

STP

Merci

Re,

Et si on passait directement à la question suivante?

Cdlt.

Je suis très novice en VBA!

Je voudrais juste savoir comment masquer les colonnes en désordre, par ex: le filtre masque les colonnes C, D et F ???????

C'est la dernière kestion je t'assure

Jean-Eric

Merci!!!!

Jean-Eric

Merci pour le support, je suis partie de tes suggestions pour finir par élaborer un truc répondant à mes attentes