Macro - filtre sur 3 colonnes

Bonjour forum,

J'ai une macro sommaire qui permet de filtrer 2 colonnes en choisissant des codes spécifiques. Toutefois, à la 2e étape je souhaiterais désactiver le filtre puis le rétablir, ensuite filtrer une 3e colonne (colonne 20) pour aller chercher les valeurs 04 et 13 puis faire le copier/coller de l'onglet "Import général" vers l'onglet "Groupe MRA_Rappel_Neige".

 Sub Groupe_MRA_Rappel_Neige()
'
' Groupe_MRA_Rappel_Neige

    Sheets("Import général").Select
    If Worksheets("Import général").AutoFilterMode = True Then                  'Test si filtre est activé
        Worksheets("Import général").AutoFilterMode = False                      'Si oui désactivation
        End If

    ActiveSheet.Range("$A$1:$AC$30005").AutoFilter Field:=29, Criteria1:=Array("603240", "600530", "600190", "601130", "601420", "601480", "600260", "601950", "220900", "213470", "208260", "213540", "200630", "221430", "255710"), Operator:=xlFilterValues
    ActiveSheet.Range("$A$1:$AC$30005").AutoFilter Field:=10, Criteria1:=Array("603240", "600530", "600190", "601130", "601420", "601480", "600260", "601950", "220900", "213470", "208260", "213540", "200630", "221430", "255710"), Operator:=xlFilterValues
    Range("A2:V2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Groupe MRA_Rappel_Neige").Select
    Range("A3").Select
    ActiveSheet.Paste
End Sub

Si possible qu'à la fin, toutes les données soient sélectionnées.

N'hésitez pas si vous avez besoin de clarification.

Merci

Je vous colle le code ci-dessous:

Bonjour,

Sans fichier pour tester ?

Regardes pour ce code si il convient :

 Sub Groupe_MRA_Rappel_Neige()

    Dim Lig As Long

    With Worksheets("Import général")

        If .AutoFilterMode = True Then .AutoFilterMode = False

        .Range("$A$1:$AC$30005").AutoFilter Field:=29, Criteria1:=Array("603240", "600530", "600190", "601130", "601420", "601480", "600260", "601950", "220900", "213470", "208260", "213540", "200630", "221430", "255710"), Operator:=xlFilterValues
        .Range("$A$1:$AC$30005").AutoFilter Field:=10, Criteria1:=Array("603240", "600530", "600190", "601130", "601420", "601480", "600260", "601950", "220900", "213470", "208260", "213540", "200630", "221430", "255710"), Operator:=xlFilterValues

        .AutoFilter.Range.EntireRow.Copy Worksheets("Groupe MRA_Rappel_Neige").Range("A3")

        .AutoFilterMode = False

        .Range("$A$1:$AC$30005").AutoFilter Field:=20, Criteria1:=Array("04", "13"), Operator:=xlFilterValues

        With Worksheets("Groupe MRA_Rappel_Neige"): Lgn = .Cells(.Rows.Count, 1).End(xlUp).Row + 1: End With

        .AutoFilter.Range.EntireRow.Copy Worksheets("Groupe MRA_Rappel_Neige").Range("A" & Lig)

    End With

End Sub

Salut Theze,

Merci pour la réponse rapide.

Effectivement, c'est plus simple de joindre un fichier. Je l'ai épuré du mieux que je peux car il est "obèse", il fait 26 Mo d'origine mais là y est rendu à 11 Mo. Voici le lien

Le bouton Groupe MRA-rappel neige va copier les données de l'onglet "Import général" vers l'onglet "Groupe MRA_Rappel_Neige" via la macro "Sub Groupe_MRA_Rappel_Neige()" dans le module "MAJBranchesetgroupes"

Donc, si c'est possible d'ajouter à la macro l'instruction de copier toutes les lignes des accréditations 04 et 13 à la colonne 20 de l'onglet "Import général".

Merci bien.

Bonjour,

Voici le code retouché (j'ai rectifié la faute entre Lig et Lng !) :

Sub Groupe_MRA_Rappel_Neige()

    Dim Lig As Long

    With Worksheets("Import général")

        .AutoFilterMode = False

        'premier et second filtrage
        .Range("$A$1:$AC$30005").AutoFilter Field:=29, Criteria1:=Array("603240", "600530", "600190", "601130", "601420", "601480", "600260", "601950", "220900", "213470", "208260", "213540", "200630", "221430", "255710"), Operator:=xlFilterValues
        .Range("$A$1:$AC$30005").AutoFilter Field:=10, Criteria1:=Array("603240", "600530", "600190", "601130", "601420", "601480", "600260", "601950", "220900", "213470", "208260", "213540", "200630", "221430", "255710"), Operator:=xlFilterValues

        'supprime tout de la feuille
        Worksheets("Groupe MRA_Rappel_Neige").Cells.Clear

        'copie le résultat du filtrage à partir de la cellule A1
        .AutoFilter.Range.EntireRow.Copy Worksheets("Groupe MRA_Rappel_Neige").Range("A1")

        'supprime le filtre
        .AutoFilterMode = False

        'troisième filtrage
        .Range("$A$1:$AC$30005").AutoFilter Field:=20, Criteria1:=Array("04", "13"), Operator:=xlFilterValues

        'défini la première ligne dispo pour le collage du résultat du filtrage
        With Worksheets("Groupe MRA_Rappel_Neige"): Lig = .Cells(.Rows.Count, 1).End(xlUp).Row + 1: End With

        'copie
        .AutoFilter.Range.EntireRow.Copy Worksheets("Groupe MRA_Rappel_Neige").Range("A" & Lig)

        'supprime le filtre
        .AutoFilterMode = False

    End With

    With Worksheets("Groupe MRA_Rappel_Neige")

        'comme la copie du filtre embarque la ligne d'entêtes, la supprime
        .Rows(Lig).EntireRow.Delete

        'active la feuille pour voir le résultat
        .Activate

    End With

End Sub

Bonjour Theze,

C'est presque parfait, il ne reste qu'une dernière modification. En fait, est-ce possible de copier seulement les données jusqu'à la colonne V (Date_mise_a_jour) de l'onglet "Import général" et les coller à l'onglet "Groupe MRA_Rappel_Neige" à partir de la cellule A3 (on garde toujours la 2e ligne comme référence). Je te joins une capture de l'en-tête "Groupe MRA_Rappel_Neige".

1

Merci

Bonjour,

Voila le code dont la copie est faite à partir de A3 mais attention, la copie du filtre embarque les entêtes de colonnes !

Pour ne garder que les données jusqu'à la colonne V, il suffit de supprimer les colonnes en trop (W à AD) :

Sub Groupe_MRA_Rappel_Neige()

    Dim Lig As Long

    With Worksheets("Import général")

        .AutoFilterMode = False

        'premier et second filtrage
        .Range("$A$1:$AC$30005").AutoFilter Field:=29, Criteria1:=Array("603240", "600530", "600190", "601130", "601420", "601480", "600260", "601950", "220900", "213470", "208260", "213540", "200630", "221430", "255710"), Operator:=xlFilterValues
        .Range("$A$1:$AC$30005").AutoFilter Field:=10, Criteria1:=Array("603240", "600530", "600190", "601130", "601420", "601480", "600260", "601950", "220900", "213470", "208260", "213540", "200630", "221430", "255710"), Operator:=xlFilterValues

        'supprime tout de la feuille
        Worksheets("Groupe MRA_Rappel_Neige").Cells.Clear

        'copie le résultat du filtrage à partir de la cellule A1
        .AutoFilter.Range.EntireRow.Copy Worksheets("Groupe MRA_Rappel_Neige").Range("A3")

        'supprime le filtre
        .AutoFilterMode = False

        'troisième filtrage
        .Range("$A$1:$AC$30005").AutoFilter Field:=20, Criteria1:=Array("04", "13"), Operator:=xlFilterValues

        'défini la première ligne dispo pour le collage du résultat du filtrage
        With Worksheets("Groupe MRA_Rappel_Neige"): Lig = .Cells(.Rows.Count, 1).End(xlUp).Row + 1: End With

        'copie
        .AutoFilter.Range.EntireRow.Copy Worksheets("Groupe MRA_Rappel_Neige").Range("A" & Lig)

        'supprime le filtre
        .AutoFilterMode = False

    End With

    With Worksheets("Groupe MRA_Rappel_Neige")

        'comme la copie du filtre embarque la ligne d'entêtes, la supprime
        .Rows(Lig).EntireRow.Delete
        .Columns("W:AD").Delete

        'active la feuille pour voir le résultat
        .Activate

    End With

End Sub

Bonjour Theve,

Merci encore pour ta précieuse aide

Y a-t-il pas moyen de ne copier que les données de la plage A:V (sans l'en-tête) ?

Puis les coller à partir de la cellule A3 dans l'onglet Groupe MRA_Rappel_Neige pour le premier et deuxième filtre

Puis coller à partir la prochaine ligne disponible le 3e filtre.

Je ne voudrais ni les 2 premières lignes (en-tête et ligne de référence) ni la dernière colonne de l'onglet Groupe MRA_Rappel_Neige ne s'effacent.

Bonjour,

Y a-t-il pas moyen de ne copier que les données de la plage A:V (sans l'en-tête) ?

Comme dit dans les posts précédents, la méthode "Copy" de "AutoFilter" embarque d'office les entêtes donc, il suffit une fois collé de supprimer la ligne (voir plus bas) !

Puis les coller à partir de la cellule A3 dans l'onglet Groupe MRA_Rappel_Neige pour le premier et deuxième filtre

Puis coller à partir la prochaine ligne disponible le 3e filtre.

C'est ce que fait la procédure que je t'ai donné !!!

Je ne voudrais ni les 2 premières lignes (en-tête et ligne de référence)...

Avec cette ligne de code, tu supprimes la ligne d'entêtes et la suivante :

Worksheets("Groupe MRA_Rappel_Neige").Rows("3:4").EntireRow.Delete

...ni la dernière colonne de l'onglet Groupe MRA_Rappel_Neige ne s'effacent.

Par contre là, je ne comprend pas ce que tu veux dire ? Finalement, tu ne veux pas supprimer les dernières colonnes ?

Bon, voici le code complet pour qui inclus la suppression de la ligne d'entêtes et la suivante :

Sub Groupe_MRA_Rappel_Neige()

    Dim Lig As Long

    With Worksheets("Import général")

        .AutoFilterMode = False

        'premier et second filtrage
        .Range("$A$1:$AC$30005").AutoFilter Field:=29, Criteria1:=Array("603240", "600530", "600190", "601130", "601420", "601480", "600260", "601950", "220900", "213470", "208260", "213540", "200630", "221430", "255710"), Operator:=xlFilterValues
        .Range("$A$1:$AC$30005").AutoFilter Field:=10, Criteria1:=Array("603240", "600530", "600190", "601130", "601420", "601480", "600260", "601950", "220900", "213470", "208260", "213540", "200630", "221430", "255710"), Operator:=xlFilterValues

        'supprime tout de la feuille
        Worksheets("Groupe MRA_Rappel_Neige").Cells.Clear

        'copie le résultat du filtrage à partir de la cellule A3
        .AutoFilter.Range.EntireRow.Copy Worksheets("Groupe MRA_Rappel_Neige").Range("A3")

        'supprime le filtre
        .AutoFilterMode = False

        'suppression de la ligne d'entêtes et de la ligne qui la suit
        Worksheets("Groupe MRA_Rappel_Neige").Rows("3:4").EntireRow.Delete

        'troisième filtrage
        .Range("$A$1:$AC$30005").AutoFilter Field:=20, Criteria1:=Array("04", "13"), Operator:=xlFilterValues

        'défini la première ligne dispo pour le collage du résultat du filtrage
        With Worksheets("Groupe MRA_Rappel_Neige"): Lig = .Cells(.Rows.Count, 1).End(xlUp).Row + 1: End With

        'copie
        .AutoFilter.Range.EntireRow.Copy Worksheets("Groupe MRA_Rappel_Neige").Range("A" & Lig)

        'supprime le filtre
        .AutoFilterMode = False

    End With

    With Worksheets("Groupe MRA_Rappel_Neige")

        'comme la copie du filtre embarque la ligne d'entêtes, la supprime
        .Rows(Lig).EntireRow.Delete
        .Columns("W:AD").Delete
        'active la feuille pour voir le résultat
        .Activate

    End With

End Sub

Bonjour Theze,

Merci pour ta précieuse aide

Au plaisir !

Bonjour subirubi,

Heureux d'avoir pu t'aider !

Rechercher des sujets similaires à "macro filtre colonnes"