Filtre par élément d'une colonne et sauvegarde fichiers au format xlsx

**Kellly** · 01/10/2018, 19h38

Bonjour tous,

Je suis débutant en VBA et je voudrais réaliser une macro qui va filtrer une colonne et extraire les fichier relatifs à chaque critère du filtre.
Par la même occasion, la macro devra sauvegarder dans un répertoire (et dans le même dossier) les fichiers (extraits) par nom de chaque filtre.
Cf. tableau ci-dessous : colonne à filtrer ==> PAYS D'ORIGINE"
Filtre par =======> Pays (France, Danemark, Espagne)

Résultat attendu :
3 fichiers au nom de chaque pays (filtre), sauvegardés dans le même répertoire (dans le même dossier)

J'ai tenté un enregistrement de la macro, pour ensuite la modifier.
Voici le résultat obtenu :

DATE D'ARRIVÉ	MATÉRIEL	PAYS D'ORIGINE	QUANTITÉ
21/05/2014	Ordinateur	France	12
30/04/2010	Logiciel	Danemark	7
01/06/2008	Logiciel	Danemark	8
06/03/2007	Périphérique	Espagne	17
31/07/2015	Ordinateur	Espagne	1
01/02/2016	Logiciel	France	9
02/03/2011	Logiciel	France	21
03/04/2008	Périphérique	France	19
04/05/2009	Ordinateur	Danemark	16

Voici mon code erroné :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Sub Première_macro()
' Première_macro Macro
' Filtre par pays et enregistrements des fichiers par filtre
'
    Sheets("SOURCE").Select 'Feuille servant de source d'extraction
    Rows("1:1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$D$10").AutoFilter field:=3, Criteria1:=Array("France", "Danemark3", "Espagne")
    Cells.Select
    Selection.Copy
    Sheets("Extraction").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
    Sheets("SOURCE").Select
    Application.CutCopyMode = False
    ActiveSheet.ShowAllData
    Selection.AutoFilter
    Range("E1").Select
    Sheets("Extraction").Select
    Range("E1").Select
 
'   suppression de la feuille "SOURCE "pour ne conserver que la feuille "Extraction"
    Sheets("SOURCE").Select 
    Application.DisplayAlerts = False
    ActiveWindow.SelectedSheets.Delete                      'supprimer cette feuille "SOURCE"
    Application.DisplayAlerts = True 
 
'   Definir les noms des fichiers par filtre et le repertoire de sauvegarde de ces fichiers
    Dim strDate As String, extension As String
    Dim chemin As String, nomfichier As String
    strDate = Format(Now + 0 / 24, "dd_mm_yyyy hh""h""mm")
    extension = ".xlsx"
    nomfichier = "_" & strDate & extension
    chemin = "C:\Users\monrepertoire" & nomfichier
    ActiveSheet("Extraction").SaveAs Filename:=chemin
    Close
    'on revient au fichier source
    wbk.Activate
End Sub

Pourriez-vous m'aidez à trouver le bon code (ou corriger celui-ci)
Merci d'avance pour votre aide

Cordialement

**Philippe Tulliez** · 01/10/2018, 19h56

Bonjour,

Cf. tableau ci-dessous : colonne à filtrer ==> PAYS D'ORIGINE"
Filtre par =======> Pays (France, Danemark, Espagne)

Le filtre avancé d'excel peut t'apporter la solution attendue en ce qui concerne l'exportation
A lire Les filtres avancés ou élaborés dans Excel

Des exemples et solutions diverses dans ces discussions
Exemple proche de cette demande
Exemple d'exportation suivant critères avec toutes les colonnes et des colonnes partielles

**Kellly** · 01/10/2018, 22h25

Bonjour Philippe et merci pour ton retour,

Lorsque j'applique le code, j'obtiens un copier -coller de la feuille "SOURCE" sur la même feuille.
Ce que je voudrais, c'est 1 filtre par variable dans la colonne "PAYS D'ORIGINE" et sauvegarder le fichier obtenu dans un repertoire.

Comment procéder?

Merci de l'aide

**Philippe Tulliez** · 01/10/2018, 22h39

Bonjour,
Je t'ai donné pourtant un lien qui correspond à ta demande. Evidemment le "split" des données se fait sur le même classeur mais à toi d'analyser la façon dont l'exportation est organisée et l'adapter à tes besoins.

**Kellly** · 02/10/2018, 17h59

Ci dessous, la macro via l'enregistreur de macro.
Elle marche bien,mais ne convient pas à mon besoin.

Mon besoin :
Mettre une boucle qui m'évite une saisie quasi manuelle dues critère de filtre.
Je voudrais mettre une variable "X" comme critère de tri, X étant la variable (France, Danemark, Espagne)
je voudrais que par variable, la macro filtre le tableau et enregistre le fichier (nom du fichier = nom de la variable de filtre); ainsi de suite jusqu'à la fin de la revue de toutes les variable.

Pourriez-vous corriger mon code avec une boucle, ce qui m'évitera la répétition de la même action à chaque fois.

Merci de votre aide

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
Sub Filtre()
'
' Filtre Macro
'
 
'
    Range("A1:D10").Select
    Selection.Copy
    Sheets("Criteres").Select
    ActiveSheet.Paste
    Range("E1").Select
    Application.CutCopyMode = False
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$D$10").AutoFilter Field:=3, Criteria1:="France"
    Range("A1:D9").Select
    Selection.Copy
    Workbooks.Add
    ActiveSheet.Paste
    Range("E1").Select
    Application.CutCopyMode = False
    ChDir "C:\Users\Joseph\Documents\Doc_Jo\VBA\Macro_Excel"
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Repertoire\France_filtre.xlsx", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
    ActiveSheet.ShowAllData
    Range("E1").Select
    ActiveSheet.Range("$A$1:$D$10").AutoFilter Field:=3, Criteria1:="Espagne"
    Range("A1:D6").Select
    Selection.Copy
    Workbooks.Add
    ActiveSheet.Paste
    Range("E1").Select
    Application.CutCopyMode = False
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\Repertoire\Espagne_filtre.xlsx", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
    ActiveSheet.ShowAllData
    ActiveSheet.Range("$A$1:$D$10").AutoFilter Field:=3, Criteria1:="Danemark"
    Range("A1:D10").Select
    Selection.Copy
    Workbooks.Add
    ActiveSheet.Paste
    Range("E1").Select
    Application.CutCopyMode = False
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Repertoire\Danemark_filtre.xlsx", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
    Columns("A:I").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
    Sheets("Base").Select
    Range("E1").Select
End Sub

**Philippe Tulliez** · 02/10/2018, 18h41

Bonjour,
On se demande parfois à quoi sert de répondre pour apporter une solution simple alors que l'on persiste à vouloir travailler autrement.

Mon besoin :
Mettre une boucle qui m'évite une saisie quasi manuelle dues critère de filtre

Sauf erreur de ma part, ton besoins est d'extraire toutes les lignes dont la valeur de la colonne 3 contient la valeur "France", ensuite "Espagne", puis "Danemark" et ainsi de suite mais pas de faire une boucle. Cela c'est la manière que tu voudrais utiliser.
Que feras-tu quand demain il y aura également Belgique, Allemagne et peut-être plus d'Espagne ?
La solution que je propose dans mon lien le fait mais il faut bien entendu prendre du temps pour l'examiner.

**Kellly** · 02/10/2018, 18h51

Rebonjour Philippe,

Tu as exactement saisi mon besoin.
N'arrivant pas à faire avec les filtres avancé (je suis vraiment débutant en VBA), j'ai procédé autrement et voilà, toujours bloqué.
Mais mon besoin est bien comme tu le mentionne

Mais comment le coder .. pourrais-tu m'aider

merci

**Philippe Tulliez** · 02/10/2018, 19h26

Bonjour,
As-tu au moins lu le tutoriel proposé et essayé manuellement pour voir comment se comporte le filtre avancé d'excel ?

Les étapes à suivre sont les suivantes

Extraire une liste unique à l'aide de la méthode AdvancedFilter
Cette liste étant crée elle deviendra le critère pour extraire ensuite chaque ligne contenant le pays
Créer une boucle équivalent au nombre de pays (le nombre de lignes de la liste unique) et utiliser les deux cellules du haut (Titre + nom du premier pays) comme zone des critères
1. extraire à l'aide de la méthode AdvancedFilter les lignes contenant le pays (ligne 2 de la zone des critères) vers une feuille export
2. supprimer la ligne deux de la zone des critères (ainsi la ligne 3 et les suivantes remontent et nouvelle ligne 3 devient le prochain pays dont on va extraire les données
3. copier la feuille contenant les lignes exportées sur une autre feuille du même classeur ou dans un autre classeur

Je n'ai aucun problème d'apporter mon aide mais certainement pas de donner un code tout cuit.

Illustration du résultat après l'étape 1 (Ce qui encadré en rouge, c'est la zone des critères qui va servir pour extraire le premier pays (Espagne))

Nom : 181002 - AdvancedFilter Split.png
Affichages : 891
Taille : 31,1 Ko

Nom : 181002 - AdvancedFilter Split.png
Affichages : 891
Taille : 31,1 Ko

**RyuAutodidacte** · 02/10/2018, 21h35

Bonsoir,

la méthode que propose @Philippe Tulliez (

) est la plus simple à mettre en oeuvre
et je dirai même plus, vu le nombre de pays dérisoires, tu aurais aussi vite de le faire manuellement que par macro étant donné que tu es novice …
les explications dans le liens donnés sont claires, et même si cela ne suffit pas il y a plein d'exemples vidéos en tutos sur le net
si cela te permet de mieux visualiser pour une meilleure compréhension
et la meilleure façon d'apprendre et de tester, déjà en le faisant manuellement pour en voir le résultat,
et quand tout cela est ok il y a aussi l'enregistreur de macro te permettant de faire un premier code avec les manipulations que tu auras validé dans tes tests donnant le résultat voulu
à mon avis en s'y mettant bien pour faire ceci ça ne sera pas plus de 2 heures
De plus tu à la démarche détaillé par @Philippe Tulliez

**Kellly** · 02/10/2018, 21h38

En passant par le filtre avancé et l'enregistrement de macro, voici ce que j’obtiens (Cf. ci-dessous)
Problème : Comment bouclé afin que la macro gère seule et en une fois toute les valeur du filtre et enregistre fichier par fichier dans le même répertoire?

Help..

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub Filtre()
'
' Filtre Macro
'
 
'
    Sheets("Base").Range("A1:D10").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sheets("Critere").Range("A1:A2"), CopyToRange:=Range("A1"), _
        Unique:=True
    Range("A1:D5").Select
    Selection.Copy
    Workbooks.Add
    ActiveSheet.Paste
    Range("E1").Select
    Application.CutCopyMode = False
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Repertoire\France_Filtre.xlsx", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
    Columns("A:D").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
    Sheets("Base").Select
End Sub

**RyuAutodidacte** · 02/10/2018, 21h44

Peux tu mettre ton code entre les balise [CODE]toncode[/CODE ] stp, pour une meilleure lisibilité
il y a un exemple dans ma signature

Edit :
une fois le résultat des pays obtenu tu peux passer par une boucle :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Do While condition
 'Actions
Loop
'Qui peut être traduit par:
'[Faire] [Tant que] condition
   'Les actions à effectuer
'[Recommencer]

sur le critère du pays
pour les boucles voir ici : La gestion des boucles dans Excel
Le principe :
une fois les pays obtenus,
faire la manip du filtre avancé pour un pays dans la boucle tant que la cellule du critère n'est pas vide
une fois fait pour un pays effacer le critère avant la fin de la boucle effacer en faisant remonter les autres pays vers le haut
quand il n y a plus de critères le code s'arrêtera de lui même

**Kellly** · 02/10/2018, 22h09

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub Filtre()
'
' Filtre Macro
'
 
'
Sheets("Base").Range("A110").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Critere").Range("A1:A2"), CopyToRange:=Range("A1"), _
Unique:=True
Range("A15").Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Range("E1").Select
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:= _
"C:\Repertoire\France_Filtre.xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
Columns("A").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Sheets("Base").Select
End Sub

**Kellly** · 02/10/2018, 22h18

Bonjour Ryu,

..et surtout merci pour cete intervention.
Les balises je ne connaissais pas.

Effectivement le code est maintenant lisible..

Mais comment faire pour un filtre avancé qui gère seul et enregistre seul?

Effectivement je tente d'appliquer les conseils de Philippe. Pas évident pour un débutant.
Ensemble on va certainement y arriver ..

Merci

**RyuAutodidacte** · 02/10/2018, 22h34

j'ai édité mon post d'avant, regarde et test la boucle en faisant une action simple et en passant le code en pas à pas (concerne les critères)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Sub Exemple()
    Do While Sheets("Base").Range("F2") <> ""
        Sheets("Base").Range("F2").Delete Shift:=xlUp
    Loop
End Sub

sur le colonne F

Pays

France

Espagne

Italie

Portugal

**Philippe Tulliez** · 02/10/2018, 22h38

Bonjour,
Voici un exemple d'une fonction qui va créer une liste unique des valeurs contenues dans une colonne.
Cette liste sera placée deux colonnes à droite de la base de données

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Function SingleList(DataSource As Range, Label As String) As Range
  ' Function quie crée la liste unique et renvoie un objet Range
  ' Arguments
  ' DataSource  ' Les données
  ' Label       ' Etiquette de colonne dont on veut extraire la liste unique
  Dim areaTarget As Range
  With DataSource
    ' Renvoie la cellule qui se trouve deux colonnes à droite de la plage source
    Set areaTarget = .Offset(ColumnOffset:=.Columns.Count + 1).Resize(1, 1)
  End With
  areaTarget.Value = Label
  DataSource.AdvancedFilter xlFilterCopy, CopyToRange:=areaTarget, Unique:=True
  Set SingleList = areaTarget.CurrentRegion
  Set areaTarget = Nothing
End Function

et voici la procédure qui invoque cette fonction. Cela constitue l'étape 1

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub TestSingleList()
  ' Déclaration des variables
  Dim rngSource As Range    ' Plage source
  Dim rngCriteria As Range  ' Plage où se trouve les critères
  Dim rngTarget As Range    ' Cellule cible
  Dim ListPays As Range     ' Plage qui contiendra la liste unique des pays
  '
  Set rngSource = shtData.Range("A1").CurrentRegion
  Set rngTarget = shtTarget.Range("A1")
  ' Extraction de la liste unique des pays
  Set ListPays = SingleList(rngSource, "Pays")
  ' Définition de la zone des critères
  Set areaCriteria = ListPays.Resize(2) ' Zone des critères = 2 lignes de la liste des pays
  '
 
End Sub

**Kellly** · 02/10/2018, 23h18

Je me penche dessus et vous tiens informé

**Kellly** · 03/10/2018, 01h06

Liste des pays créee via le filtre avancé.
1ère étape terminé, je suppose.

Ci-dessous le code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Sub CritereFiltre()
' CritereFiltre Macro
'
    Range("ListePays").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
        "F1"), Unique:=True
End Sub

Reste l'étape 2,pour la création de la boucle (Cf. Philippe)
Je regarde cademain et vous tiens informé de l'avancement

@ Ryu
Je teste la boucle également demain dans le cadre de l'étape 2

Au final, le code actuel ressemble à ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Sub CritereFiltre()
' CritereFiltre Macro
'
    Range("ListePays").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
        "F1"), Unique:=True
End Sub
Sub Filtre()
' Filtre Macro
'
    Sheets("Resultat").Select
    Sheets("Base").Range("A1:D10").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sheets("Critere").Range("A1:A2"), CopyToRange:=Range("A1"), _
        Unique:=True
    Range("A1:D5").Select
    Selection.Copy
    Workbooks.Add
    ActiveSheet.Paste
    Columns("A:A").EntireColumn.AutoFit
    Columns("B:B").EntireColumn.AutoFit
    Columns("C:C").EntireColumn.AutoFit
    Columns("D:D").EntireColumn.AutoFit
    Range("E1").Select
    Application.CutCopyMode = False
    ChDir "C:\Repertoire"
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Repertoire\nomFichier.xlsx", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
    Columns("A:D").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
    Sheets("Critere").Select
    Range("B1").Select
    Sheets("Base").Select
End Sub

**Kellly** · 03/10/2018, 09h59

Bonjour,

J'en suis à ce niveau :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
Sub ListePays()
' ListePays Macro
'
    Range("ListePays").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("A1"), Unique:=True
    Columns("A:A").EntireColumn.AutoFit
End Sub
Sub FiltrePays()
' FiltrePays Macro
'
    Sheets("Source").Range("A1:D10").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sheets("Critere").Range("A1:A2"), CopyToRange:=Range("A1"), _
        Unique:=True
    Range("A1:D5").Select
    Selection.Copy
    Workbooks.Add
    ActiveSheet.Paste
    Range("E1").Select
    Application.CutCopyMode = False
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Repertoire\France_Filtre.xlsx", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
    Columns("A:D").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
    Sheets("Critere").Select
    Rows("2:2").Select
    Selection.Delete Shift:=xlUp
    Range("B1").Select
    Sheets("Résultat").Select
    Sheets("Source").Range("A1:D10").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sheets("Critere").Range("A1:A2"), CopyToRange:=Range("A1"), _
        Unique:=True
    Range("A1:D4").Select
    Selection.Copy
    Workbooks.Add
    ActiveSheet.Paste
    Range("E1").Select
    Application.CutCopyMode = False
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Repertoire\Danemark_Filtre.xlsx", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
    Columns("A:D").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
    Sheets("Critere").Select
    Rows("2:2").Select
    Selection.Delete Shift:=xlUp
    Range("B1").Select
    Sheets("Résultat").Select
    Sheets("Source").Range("A1:D10").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sheets("Critere").Range("A1:A2"), CopyToRange:=Range("A1"), _
        Unique:=True
    Range("A1:D3").Select
    Selection.Copy
    Workbooks.Add
    ActiveSheet.Paste
    Range("E1").Select
    Application.CutCopyMode = False
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Repertoire\Espagne_Filtre.xlsx", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
    Columns("A:D").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
    Sheets("Critere").Select
    Rows("2:2").Select
    Selection.Delete Shift:=xlUp
    Range("A2").Select
End Sub

Concernant la boucle, elle devra sélectionner automatiquement le pays à filtrer et sauvegarder automatiquement le résultat
obtenu dans le répertoire avec comme nom du fichier le nom du pays filtré.
Ainsi de suite jusqu'à ce qu'il n'y ai plus rien à filtrer.

Merci pour votre aide...

De mon coté je regarde la boucle et vous reviens....

**Philippe Tulliez** · 03/10/2018, 10h35

Bonjour,
J'arrête mon aide parce-que tu ne tiens pas compte de ce que j'écris.
Pour l'étape 2. Où est ta boucle sur chaque éléments de la liste des pays ?
Lit les tutoriels avant de commencer à coder sans comprendre ce que tu fais ou ce que tu copies/colles
Le premier tutoriel que je te conseille La gestion des boucles dans Excel et je suis convaincu que tu n'as pas analysé la discussion sur le sujet similaire que je t'ai conseillé d'aller voir.

Je crois également que tu n'as rien compris à l'étape 1, essaye au minimum de le faire manuellement pour comprendre

**Kellly** · 03/10/2018, 16h31

Bonjour

Erreur de compilation : Sub ou fonction non définie
C'est le message d'erreur que me renvoi l'interrogation du code; erreur sur SingleList dans Set ListPays = SingleList(rngSource, "Pays"):

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub TestSingleList()
  ' Déclaration des variables
  Dim rngSource As Range    ' Plage source
  Dim rngCriteria As Range  ' Plage où se trouve les critères
  Dim rngTarget As Range    ' Cellule cible
  Dim ListPays As Range     ' Plage qui contiendra la liste unique des pays
  '
  Set rngSource = shtData.Range("A1").CurrentRegion
  Set rngTarget = shtTarget.Range("A1")
  ' Extraction de la liste unique des pays
  Set ListPays = SingleList(rngSource, "Pays")
  ' Définition de la zone des critères
  Set areaCriteria = ListPays.Resize(2) ' Zone des critères = 2 lignes de la liste des pays
  '
 
End Sub

et du coup jsui bloqué..

De la patience et compréhension pour le débutant que je suis

Cordialement

Filtre par élément d'une colonne et sauvegarde fichiers au format xlsx

Macros et VBA Excel

Discussions similaires

Partager

Partager