Filtrage sur un tableau EXCEL par macro

Version imprimable

Bonjour,

Je me permets de solliciter votre aide sur le point suivant :

Je dispose d'un tableau sur EXCEL : NOM (colonne 1) , PRENOM (colonne 2), DEPARTEMENT (colonne 3).

Je souhaite réaliser un filtrage automatique sur ce tableau. Je souhaite filtrer sur la colonne NOM, récupérer tous les éléments présents en un seul exemplaire de la colonne PRENOM et les stocker dans un tableau.

Code:

Worksheets ("TEST").Range("A1").AutoFilter field:=1, Criteria1:="DUPONT"

Je ne sais pas comment faire pour récupérer chaque donnée unitaire de la colonne PRENOM sachant que NOM est filtré.

L'idée est de pouvoir récupérer sur une feuille le résultat de plusieurs filtrages consécutifs.

Initialement, j'ai un tableau de nom : "DUPONT", "DURANT","DUCHENE". Je souhaite obtenir sur une même feuille EXCEL, le résultat du filtrage avec "DUPONT", suivi de celui avec "DURANT", enfin suivi de celui avec "DUCHENE".

Sur la feuille résultat, il y a en première ligne l'entête. Mais quand je lance la macro, je souhaite récupérer uniquement les lignes filtrées pour chaque cas, donc sans les en-têtes.
Code:

1 2 3 4 5 6 7 8 9 10 11 Sheets("ORIGINE").Select Columns("1:4").Select Selection.AutoFilter ActiveSheet.Range("$A$1:$D$1500").AutoFilter Field:=1, Criteria1:=tab_nom(i), Operator:=xlAnd Range("A1").Select Set rngSelect = ActiveCell.CurrentRegion.SpecialCells(xlCellTypeVisible) rngSelect.Copy Sheets("FINAL").Select Cells.PasteSpecial xlPasteAll
Je ne sais pas comment faire pour que le code tienne compte notamment du nombre d'éléments dans le tableau de nom et de la dernière ligne de la feuille résultat.

Merci d'avance pour votre aide.

Bonjour,
Essaie ceci..

Code:

1
2
3
4
5
6
7
8
9
10
11
Sub Filtrer()
Dim Derlig As Long
Dim LigCopie As Long
    With Sheets("ORIGINE")
        .Columns("A:D").AutoFilter
        Derlig = .Range("A65536").End(xlUp).Row
        LigCopie = Sheets("FINAL").Range("A65536").End(xlUp).Row + 1
        .Range("$A$1:$D$1").AutoFilter Field:=1, Criteria1:=tab_nom(i), Operator:=xlAnd
        .Range("A2:D" & Derlig).Copy Sheets("FINAL").Range("A" & LigCopie)
    End With
End Sub

Les lignes filtrées seront automatiquement ajoutées l'une en dessous de l'autre, c'est ça que tu recherche ?
A+

Bonjour,

Quand je teste avec un seul élément du tableau (i=0) le code fonctionne. Mais quand j'utilise une boucle pour i=0 à 2 de tab_nom, la macro ne fonctionne pas.

Code:

1
2
3
4
5
6
7
8
9
10
11
Do while i<=2
 
    With Sheets("ORIGINE")
        .Columns("A:D").AutoFilter
        Derlig = .Range("A65536").End(xlUp).Row
        LigCopie = Sheets("FINAL").Range("A65536").End(xlUp).Row + 1
        .Range("$A$1:$D$1").AutoFilter Field:=1, Criteria1:=tab_nom(i), Operator:=xlAnd
        .Range("A2:D" & Derlig).Copy Sheets("FINAL").Range("A" & LigCopie)
    End With
 
Loop

Je souhaite savoir quelle est mon erreur.

J'ai effectué le code suivant. Mais la macro ne fonctionne pas correctement.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
     Sheets("ORIGINE").Select
      Columns("A:D").Select
      Selection.AutoFilter
      ActiveSheet.Range("$A$1:$D$1500").AutoFilter Field:=1, Criteria1:=tab_nom(0), Operator:=xlAnd
      Range("A1").Select
 
      Set rngSelect = ActiveCell.CurrentRegion.SpecialCells(xlCellTypeVisible)
      rngSelect.Copy
 
      Sheets("FINAL").Select
      Cells.PasteSpecial xlPasteAll
 
 
      for i=1 to 2
 
            Sheets("ORIGINE").Select
              ActiveSheet.Range("$A$1:$D$1500").AutoFilter Field:=1, Criteria1:=tab_nom(i), Operator:=xlAnd
 
            Derlig = Sheets("ORIGINE").Range("A65536").End(xlUp).Row
            LigCopie = Sheets("FINAL").Range("A65536").End(xlUp).Row + 1
             sheets ("ORIGINE").select
            Range("A2:D" & Derlig).Copy Sheets("FINAL").Range("A" & LigCopie)
 
      Next i

Je vous serai reconnaissante de bien vouloir m'aider.

Je ne comprend pas bien ce que tu veux faire, ? Copier toutes les lignes ? auquel cas pas besoin de filtre, enfin, quoi qu'il en soit essaye ce code...

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub Filtrer()
Dim Derlig As Long, Lig as Long
Dim LigCopie As Long
    With Sheets("ORIGINE")
    For Lig = 2 to 4 'pour pas avoir la ligne des titres
        .Columns("A:D").AutoFilter
        Derlig = .Range("A65536").End(xlUp).Row
        LigCopie = Sheets("FINAL").Range("A65536").End(xlUp).Row + 1
        .Range("$A$1:$D$1").AutoFilter Field:=1, Criteria1:= .Cells(Lig,1), Operator:=xlAnd
        .Range("A2:D" & Derlig).Copy Sheets("FINAL").Range("A" & LigCopie)
    Next Lig
    End With
End Sub

Et évite d'employer des Select à tout va. ;)
A+

24/05/2009, 20h46
cati_78

Filtrages consécutifs par macro et récupération du résultat
Bonjour,

En prenant un autre cas :

Sur la feuille "ORIGINE", je filtre sur DEPARTEMENT (colonne 3). Dans un premier temps, je choisi DEPARTEMENT="informatique", je fais un copier-coller sur la feuille "FINAL" des lignes filtrées.

Ensuite, je choisi DEPARTEMENT="électronique", je fais un copier-coller sur la feuille "FINAL" des lignes filtrées à la suite du premier.

Enfin, je choisi DEPARTEMENT="administration", je fais un copier-coller sur la feuille "FINAL" des lignes filtrées à la suite du second.

Mon soucis apparaissait lors de l'exécution de la macro sur la feuille "FINAL".
Je ne pouvais pas voir le résultat des 3 filtrages consécutifs et parfois l'entête était en plusieurs exemplaires.

Par ailleurs, je n'ai bien compris la syntaxe suivante :
Code:

1 2 .Range("$A$1:$D$1").AutoFilter Field:=1, Criteria1:= .Cells(Lig,1), Operator:=xlAnd
Cela signifie que le filtrage est activé sur la première colonne feuille "ORIGINE", mais je souhaite savoir que représente cells(3,1), cells(4,1), cells (5,1) - les 3 noms du tableau ?

Merci pour votre aide.
24/05/2009, 21h43
Qwazerty

Salut
Le fait que tu vois ton entête revenir plusieurs fois est du fait de cette ligne

Code:

Set rngSelect = ActiveCell.CurrentRegion.SpecialCells(xlCellTypeVisible)

en effet ici tu demande a excel de sélectionner l'ensemble de tes cellules visibles, l'entete est visible que je sache ;)

Il faudrait verifier e nombre de ligne contenu dans

Code:

ActiveCell.CurrentRegion.SpecialCells(xlCellTypeVisible)

, peut etre en utilisant

Code:

ActiveCell.CurrentRegion.SpecialCells(xlCellTypeVisible).Rows.Count

si nbrLigne=1, on sort de la macro, le tableau ne contient que l'entete, aucun resultat au filtre.
si nbrligne>1, il faut modifier la selection pour ne pas prendre l'entete

Code:

ActiveCell.CurrentRegion.SpecialCells(xlCellTypeVisible).resize(ActiveCell.CurrentRegion.SpecialCells(xlCellTypeVisible).Rows.Count-1,ActiveCell.CurrentRegion.SpecialCells(xlCellTypeVisible).columns.Count).offset(1,0)

Je n'ai pas testé mais ce doit être un truc comme ça ;) en fait le resize reduit la taille de la slection d'une ligne (on perd les donnée de la derniere ligne visible du tableau) et l'Offset decale la selectiond'une ligne vers le bas, on recupere les données de la derniere ligne et on abandonne celles de la 1er (l'entete si tu suis toujours ^^).

A++
Qwaz
25/05/2009, 10h57
LeForestier

bonjour Qwazerty, que crois-tu que fait cette ligne ? :?

Code:

.Range("A2:D" & Derlig).Copy Sheets("FINAL").Range("A" & LigCopie)

cati : Comment veux-tu faire tes sélections ?
Je propose, ne pas gérer le filtre par macro mais directement sur la feuille et un bouton qui te copierait le résultat du filtre sur l'autre feuille ?
25/05/2009, 17h25
Qwazerty

Salut
Je comprend bien, je répondais juste a l'incompréhension de cati_78 vis à vis de son code et j'ai essayé de garder cette même philosophie ;)
++
Qwaz