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.

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

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager