Macro filtre et copie de données dans nouveaux fichiers

**Senka-75** · 20/10/2016, 15h31

Bonjour à tous

,

J'aurais besoin de vos lumières pour une macro. Pour commencer, je tiens à dire que je suis parfaitement néophyte en ce qui concerne les Macro VBA mais que je suis parfaitement disposé à apprendre et à y consacrer du temps.

Malheureusement, je pense que ma problématique est un peu trop compliqué pour un débutant comme moi et c'est pour ça que je requiert aujourd'hui votre aide.

J'ai un fichier qui se présente comme suit (fichier joint également ci-dessous) :

Test.xlsm

client	commerciaux	score
Dubois	Jean	probable
Dutronc	Jacques	imminent
Duterque	Paul	probable
Duval	Paul	probable
Dupont	Jacques	imminent

J'aimerais pouvoir sélectionner toutes les lignes qui concerne chacun des commerciaux (Jean, Jacques et Paul) et les copier dans un nouveau fichier, donc, me retrouver avec 3 nouveaux fichiers portant les valeur suivantes:

* Fichier 1 (nom du fichier = Jean.xlsx) :

client	commerciaux	score
Dubois	Jean	probable

* Fichier 2 (nom du fichier = Jacques.xlsx) :

client	commerciaux	score
Dutronc	Jacques	imminent
Dupont	Jacques	imminent

* Fichier 3 (nom du fichier = Paul.xlsx) :

client	commerciaux	score
Duterque	Paul	probable
Duval	Paul	probable

Je tiens à préciser qu'il n'y a pas que 3 commerciaux, il y en a des centaines, et par conséquent je dois générer des centaines de fichiers différents (d'où le besoin d'une macro). J'ai également à ma disposition une liste de l'ensemble des commerciaux, mais pour l'exemple 3 suffiront (je pense

).

Voilà, je ne sais absolument pas par ou commencer et je ne vous demande par forcément une solution "clé en main" (bien que vu l'urgence de ma situation celà m'arrangerait) mais surtout de l'aide pour savoir par quel bout prendre mon soucis et progresser.

Merci d'avance pour l'aide que vous m'apporterez !

Romain

**Philippe Tulliez** · 20/10/2016, 15h56

Bonjour,
Ton problème est très simple.
Tu as une liste de données que tu veux splitter en fonction de données se trouvant dans une colonne. La solution avec la méthode AdvancedFilter (filtre avancé d'excel)
Solution que j'ai déjà proposée dans cette discussion. Il y a le code de la procédure plus un classeur à télécharger pour exemple.

**Senka-75** · 20/10/2016, 16h54

Bonjour,

Effectivement, c'est à peu près ça, je vais regarder ça de plus près histoire de comprendre le code etc etc.

Merci beaucoup même si je pense que j'aurais plusieurs questions par la suite

Est-il possible, au lieu de créer un seul fichier avec plusieurs feuilles, plusieurs fichier avec une seule feuille?

L'idée est ensuite de pouvoir envoyer chaque fichier à chaque commerciaux de manière unique, le tout en automatique?

Je ne sais pas si je suis très clair.... Peut-être est-ce déjà possible avec les feuilles?

**Philippe Tulliez** · 20/10/2016, 17h35

Bonjour,

Est-il possible, au lieu de créer un seul fichier avec plusieurs feuilles, plusieurs fichier avec une seule feuille?

Evidemment que c'est possible. Tu peux exporter sur une feuille du même classeur, d'un classeur différent, etc.

**Senka-75** · 25/10/2016, 15h39

Re-bonjour à tous

,

Me re-voilà en ayant bien avancé et en ayant en partie résolu mon problème.

La macro fonctionne impec et elle split bien mon onglets principale en différents onglets (selon 1 critère) puis enregistre ces onglets dans un fichier unique par onglet.

A présent, et là je pense que ça dépasse mes compétences, je cherche un bout de code me permettant d'envoyer en automatique un mail pour chaque fichier unique générer.

Ci-joint le fichier en question avec les macros opérationnelles. Si une âme charitable pouvait compléter le bout de code qui me manque pour que je puisse le comprendre et l'assimiler, ça m'aiderait beaucoup.

Merci d'avance vous êtes super ici !

ExportExcel.xlsm

PS: Je tiens à préciser que je ne suis pas l'auteur du code dans les macros en question de ce fichier mais ce qui est sur c'est que je le comprends et que je suis à présent parfaitement apte à le reproduire

Un grand merci donc aux anonymes qui ont contribué.

**patricktoulon** · 25/10/2016, 17h21

je te propose une solution pour ta création des sheets avec données filtrées qui sera somme toute un peu plus rapide normalement

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
Sub test()
    Dim dico, i%
    Application.DisplayAlerts = False
    For i = Sheets.Count To 2 Step -1: Sheets(i).Delete: Next
    Set dico = CreateObject("Scripting.Dictionary")
    With Sheets(1)
        For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
            If Not dico.exists(Trim(.Cells(i, 1).Value)) Then
                Sheets.Add After:=Sheets(Sheets.Count)
                Sheets(Sheets.Count).Name = .Cells(i, 1)
                Debug.Print .Cells(i, 1) & "rr"
                With .Range("$A$1:$D$24")    ' plage a adapter
                    .AutoFilter Field:=1, Criteria1:=.Cells(i, 1).Text  'mot recherché a adapter
                    .Parent.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Copy Sheets(.Cells(i, 1).Text).Cells(1, 1)
                    .AutoFilter
                End With
                dico(Trim(.Cells(i, 1))) = .Cells(i, 1)
            End If
            ' End If
        Next
    End With
End Sub

pour les mails il y a divers solution dans le forum et contrib et faq

**Senka-75** · 26/10/2016, 11h34

Bonjour à toi,

L'aide est vraiment apprécié mais je n'en suis pas encore à l'optimisation (j'espère que ça viendra !). Je suis encore sur mon histoire de mail que je n'arrive absolument pas à résoudre (et ce n'est pas faute de chercher !)

**halaster08** · 26/10/2016, 11h51

Qu'as tu essayé? et où se trouve le problème?

PS: Comme rappelé en haut de la page du forum, la plupart des gens n'ouvrent pas les pièces jointes, surtout en xlsm.

**patricktoulon** · 26/10/2016, 12h48

re

Je suis encore sur mon histoire de mail que je n'arrive absolument pas à résoudre (et ce n'est pas faute de chercher !)

purée la je comprends pas

on traite au moins 2 sujet sur les mail et excel par mois et tu dis que tu trouve rien !!!??????

perso j'utilise CDO si tu avais pris la peine de regarder ne serait ce que ma signature en bas de mes posts tu aurais déjà vu l'option CDO

maintenant si tu entends par "chercher" un code tout prêt et qui va fonctionner de suite dans ton contexte alors oui arrête de chercher tu trouvera pas

purée c'est pas compliqué
clique sur recherche avancée tape CDO ou Outlook, ou mail ,etc.....

quand je le fait j'ai plus de 500 réponses en tout et il y en a bien plus !!!!

**Senka-75** · 26/10/2016, 14h25

@patricktoulon

1 - Je suis parfaitement néophyte en ce qui concerne ces problématiques. S'y pencher prends énormément de temps, surtout quand on part de zéro, comprendre la syntaxe, les subtilités etc etc... Temps que je n'ai pas forcément, pourtant, je m'accroche

2 - J'ai effectivement écumé une bonne partie du forum et vu un nombre incalculable de sujet traitant de la chose. J'ai du coup essayé la majeure partie de ces méthodes qui effectivement marchent dans certains cas, mais pas dans le mien, et qui nécessite donc une adaptation. Adaptation que je suis parfaitement incapable de faire à ce jour, et ce n'est pas faute d'avoir essayer. Maintenant je continuerai de chercher et d'essayer des solutions jusqu'à résoudre mon problème

3 - J'ai pris le temps de regarder ce qu'il y avait dans ta signature...

@halaster08

Le code dont je dispose actuellement est celui-ci. L'objectif est qu'à chaque création d'un nouveau classeur, un mail puisse partir automatique à une adresse mail contenu dans une cellule de l'unique feuille de ce classeur et ce pour chaque classeur.

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
Option Explicit
 
Dim docDep, col, f, Ln, Lgn, commercial
Dim chemin
 
Sub Split()
 
    Set docDep = ActiveSheet
 
    'Suppression des feuilles portant le nom des commerciaux
    For Ln = 2 To Range("A" & Rows.Count).End(xlUp).Row
        For Each f In Sheets
            If f.Name = Cells(Ln, "A").Value Then
                Application.DisplayAlerts = False
                f.Delete
            End If
        Next f
    Next Ln
 
    'Split des données selon les commerciaux
    col = Cells(1, Columns.Count).End(xlToLeft).Column
    For Ln = 2 To Range("A" & Rows.Count).End(xlUp).Row 'pour la ligne 2 à la dernière ligne
        commercial = ""
        For Each f In Sheets
            If f.Name = Cells(Ln, "A").Value Then
                Lgn = f.Cells(Rows.Count, "A").End(xlUp)(2).Row
                Range(Cells(Ln, "A"), Cells(Ln, col)).Copy f.Cells(Lgn, "A")
                commercial = Cells(Ln, "A").Value
                End If
        Next f
        If commercial = "" Then
        Sheets.Add After:=ActiveSheet
        ActiveSheet.Name = docDep.Cells(Ln, "A").Value
        With docDep
        .Range(.Cells(1, 1), .Cells(1, col)).Copy Cells(1, "A")
        .Range(.Cells(Ln, 1), .Cells(Ln, col)).Copy Cells(2, "A")
        .Activate
        End With
        End If
    Next Ln
End Sub
Sub EnregistrerLesOnglets()
    chemin = ThisWorkbook.Path & "\"
    For Each f In Sheets
        f.Copy
        ActiveWorkbook.SaveAs Filename:=chemin & f.Name
        ActiveWorkbook.Close False
    Next f
 
 
End Sub

J'ai bien vu qu'il y avait de nombreux code permettant l'envoi de mail mais en générale cela concerne peu de fichier dont les noms sont déjà connus à l'avance et ou les destinataires sont peu nombreux et, là encore, déjà connus à l'avance. Ma problématique réside là.

Mais comme expliqué plus haut, je vais continuer de chercher et je trouverais bien sur un exemple plus parlant à mes yeux que je pourrais adapter, comprendre et me réapproprier faute de temps pour être assez à l'aise pour le créer de doute pièce et comprendre les mécaniques inhérentes au VBA.

A titre indicatif, j'ai également trouvé ce genre de code que j'ai essayé d'adapter et qui se rapproche le plus de ce que je veux faire mais je n'ai pas réussi (là encore, en essayant VRAIMENT...) :

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
Sub envoimail()
'test sur plusieurs agences
 
Dim Outlook As Object
Dim Mail As Object
Dim Objet As String
Dim Corps As String
Dim fichiers, dest As Variant
Dim i As Integer
Dim path As String
 
path = "C:\Mes Documents\FD\"
fichiers = Array("PARIS.xls", "BORDEAUX.xls", "NANTES.xls", "MARSEILLE.xls" )
dest = Array("Xxxx@ddsf.com", "yyyy@ddsf.com", "zzzz@ddsf.com", "wwww@ddsf.com" )
 
Objet = "Rapport d'appels du mois d'"
'Exemple de corps de texte avec texte et sauts de ligne
Corps = "Bonjour, " & _
vbCrLf & vbCrLf & _
"Ci-joint le fichiers des appels du mois passé pour votre agence." & _
vbCrLf & vbCrLf & _
"Nous restons bien entendu à votre disposition pour tout renseignement complémentaire." & _
vbCrLf & vbCrLf & _
"Cordialement." & _
vbCrLf & vbCrLf
 
 
Set Outlook = CreateObject("Outlook.Application" )
 
For i = LBound(fichiers) To UBound(fichiers)
    Set Mail = Outlook.CreateItem(0)
 
    With Mail
        .To = dest(i)
        .CC = ""
        .BCC = ""
        .Subject = Objet
        .Body = Corps
        .Attachments.Add (path & fichiers(i))
        .Display
    End With
Next i
 
End Sub

Je vois bien l'utilité du Array mais je ne connais ni le nom de mes fichiers à l'avance, ni les adresses mail. Il faudrait que je puisse me placer dans le dossier et que pour chaque fichier je puisse faire un envoi unique à un destinataire unique et ainsi de suite.

Un genre de "For each" mais pour les workbook d'un dossier... Je ne sais pas si je suis très clair. Après il y à surement des méthodes plus propres mais je réflechis en parfait profane.

**halaster08** · 26/10/2016, 15h10

http://www.developpez.net/forums/d14...71-80020005-a/

Un exemple de travail similaire, le code est vieux pas bien écrit pour la partie découpage mais c'était un de mes premiers

Quand tu fais cette boucle, tu peux y ajouter l'envoie du mail (après la sauvegarde)

Code :

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

1
2
3
4
5
    For Each f In Sheets
        f.Copy
        ActiveWorkbook.SaveAs Filename:=chemin & f.Name
        ActiveWorkbook.Close False
    Next f

Tu y a déjà l'info sur le nom de la pièce jointe.
Il te me manque le destinataire, moi j'avais ajouté une colonne avec les nom des destinaire, tu pourrait aussi faire un tableau de correspondance entre les nom et les destinaire

**Senka-75** · 26/10/2016, 16h50

Oui ! C'est ce que j'ai tenté ! Mais j'ai du très mal le réaliser parce que ça ne fonctionnait pas, je vais réessayer et si ça ne marche toujours pas, je montrerai le code utilisé pour pointer les probables erreurs.

J'avance ! Merci

Bon, j'ai tenté ça, sans succès :

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
Option Explicit
 
Dim docDep, col, f, Ln, Lgn, commercial
Dim chemin
Dim Outlook As Object
Dim Mail As Object
 
Sub Split()
 
    Set docDep = ActiveSheet
 
    'Suppression des feuilles portant le nom des commerciaux
    For Ln = 2 To Range("A" & Rows.Count).End(xlUp).Row
        For Each f In Sheets
            If f.Name = Cells(Ln, "A").Value Then
                Application.DisplayAlerts = False
                f.Delete
            End If
        Next f
    Next Ln
 
    'Split des données selon les commerciaux
    col = Cells(1, Columns.Count).End(xlToLeft).Column
    For Ln = 2 To Range("A" & Rows.Count).End(xlUp).Row 'pour la ligne 2 à la dernière ligne
        commercial = ""
        For Each f In Sheets
            If f.Name = Cells(Ln, "A").Value Then
                Lgn = f.Cells(Rows.Count, "A").End(xlUp)(2).Row
                Range(Cells(Ln, "A"), Cells(Ln, col)).Copy f.Cells(Lgn, "A")
                commercial = Cells(Ln, "A").Value
                End If
        Next f
        If commercial = "" Then
        Sheets.Add After:=ActiveSheet
        ActiveSheet.Name = docDep.Cells(Ln, "A").Value
        With docDep
        .Range(.Cells(1, 1), .Cells(1, col)).Copy Cells(1, "A")
        .Range(.Cells(Ln, 1), .Cells(Ln, col)).Copy Cells(2, "A")
        .Activate
        End With
        End If
    Next Ln
End Sub
 
Sub EnregistrerLesOnglets()
    chemin = ThisWorkbook.Path & "\"
    For Each f In Sheets
        f.Copy
        ActiveWorkbook.SaveAs Filename:=chemin & f.Name
 
Set Outlook = CreateObject("Outlook.Application")
     Set Mail = Outlook.CreateItem(0)
    With Mail
        .To = Cells(2, 5)
       .Subject = "Sujet"
       .Body = "Corps"
       .Attachments.Add chemin & f.Name
       .Display
    End With
 
        ActiveWorkbook.Close False
    Next f
 
End Sub

Apparemment ça bug à .Attachments.Add chemin & f.Name ... j'ai essayé d'autres choses mais ça ne marche toujours pas.

**patricktoulon** · 27/10/2016, 00h53

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
Sub EnregistrerLesOnglets()
    chemin = ThisWorkbook.Path & "\"
    For Each f In Sheets
        f.Copy
        ActiveWorkbook.SaveAs Filename:=chemin & f.Name &".xls"
 
Set Outlook = CreateObject("Outlook.Application")
     Set Mail = Outlook.CreateItem(0)
    With Mail
        .To = Cells(2, 5)
       .Subject = "Sujet"
       .Body = "Corps"
       .Attachments.Add chemin & f.Name & ".xls"
       .Display
    End With
 
        ActiveWorkbook.Close False
    Next f
 
 
End Sub

**Senka-75** · 27/10/2016, 09h27

Merci beaucoup. En bon boulet que je suis je me suis focaliser sur un ".xlsx" (puisque j'avais aussi tenter avec l'extension...)

C'est sur ce genre de détail que je galère encore un peu mais grâce à vous, je continue de progresser.

Gracias à tous et en particulier à Patrick.

Bonne journée

Macro filtre et copie de données dans nouveaux fichiers [XL-2010]

Macros et VBA Excel

Discussions similaires

Partager

Partager