Discussion :

[Kellly]

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