VBA sur filtre répété

Question

Bonjour, 

J'ai fait un code VBA pour demander un filtre, copier/coller le résultat dans un nouveau fichier qu'il renomme avec le nom d'une des cellules et enfin envoyer un mail.

Sub CreationFichier()
'
' Macro2 Macro
'

'Macro sur la première franchise
        ActiveSheet.Range("$A$1:$M$19").AutoFilter Field:=2, Criteria1:="A"
    Cells.Select
    Application.CutCopyMode = False
    Selection.Copy
    Workbooks.Add
    Cells.Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
    Dim CheminA As String
    chemin = "C:\DossierEssai"
    ActiveWorkbook.SaveAs Filename:=chemin & "\" & Worksheets("Feuil1").[B2].Value

    
    SendEMailwithAttachments

    ActiveWorkbook.Close savechanges:=False
    
    ''Macro sur la deuxième franchise
    
        ActiveSheet.Range("$A$1:$M$19").AutoFilter Field:=2, Criteria1:="B"
    Cells.Select
    Application.CutCopyMode = False
    Selection.Copy
    Workbooks.Add
    Cells.Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
    Dim CheminB As String
    chemin = "C:\DossierEssai"
    ActiveWorkbook.SaveAs Filename:=chemin & "\" & Worksheets("Feuil1").[B2].Value

    
    SendEMailwithAttachments

    ActiveWorkbook.Close savechanges:=False

End Sub

Néanmoins, au lieu de mettre autant de fois le code que de filtre à faire ... comment puis-je demander à ce qu'il fasse tout ceci sur toutes les données possible du filtre dans la colonné définie ?

Merci de votre aide.

lermite222 · Answer

Bonjour,
Pas clair ton explication (ni le code d'ailleurs), pourrais-tu mettre un classeur exemple sans donnée confidentielle avec une feuille qui reprendrait ce que tu veux envoyer 
Sur Cjoint.fr par exemple.
A+

Naniecouette · Answer

Voici le lien : http://cjoint.com/?0Aesxcu4rEs

Donc la macro fait un filtre sur la donnée A, puis colle le résultat dans un nouveau fichier pour le nommer en A. Elle fait ensuite appel à une seconde macro pour envoyer ce fichier créé par mail.

J'ai fait le code pour également B.

Bref, ça marche nickel.

Sauf que j'aurai une centaine de filtre à faire ... en gros toutes les données possible de la colonne en question.

Comment faire un code qui me pemette de dire de filtrer toutes les données les unes après les autres sans avoir à copier / coller le code moi même 10000 fois en changeant en plus à chaque fois le A en B, puis en C, puis en D ...

Merci de votre aide.

eriiic · Answer

Bonjour,

une proposition :
Dim franchise As String
Sub mailFranchises()
    Dim derlig As Long, lig As Long, listeFr
    derlig = Cells(Rows.Count, "B").End(xlUp).Row
    Range("B1:B" & derlig).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
    Range("B2:B" & derlig).Copy [Feuil2!A1]
    Application.CutCopyMode = False
    With [Feuil2]
        For lig = 1 To .Cells(Rows.Count, "A").End(xlUp).Row
            franchise = .Cells(lig, "A")
            CreationFichier
        Next lig
    End With
    ActiveSheet.ShowAllData
End Sub et utiliser 'franchise' en Criteria1

https://www.cjoint.com/c/CAfnXlcx5LO

eric

lermite222 · Answer

Bonjour Eric,
Grrrr ça fait deux heures que je recherche AdvancedFilter , je retrouvais plus le nom, j'avais contourner le problème avec une copie + suppression des doublons mais ta solution est de loin la "plus élégante".
A+

Naniecouette · Answer

Merci énormément de votre aide ... :)
A priori, il reste un petit truc à voir, j'attend donc de vos nouvelles car je commence à moins comprendre là ! Novice moi ... Ih ih ih
Quelle macro sera donc à lancer pour faire tout le nécessaire ?
Bon dimanche.

lermite222 · Answer

Re,
Pour t'évité tout les  select et Copier/coller, une version complète..
Sub mailFranchises()
Dim Wks As Worksheet
Dim derlig As Long, lig As Long
Dim Chemin As String, Plage As String
    Chemin = "C:\DossierEssai\"
    Set Wks = Sheets("Feuil1")
    derlig = Wks.Cells(Rows.Count, "B").End(xlUp).Row
    Plage = Wks.Range("A1:F" & derlig).Address

    With Sheets("Feuil2")
        .Columns(1).ClearContents
        Wks.Range("B1:B" & derlig).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
        Wks.Range("B2:B" & derlig).Copy .[A1]
        For lig = 1 To .Cells(Rows.Count, "A").End(xlUp).Row
            Wks.Range(Plage).AutoFilter Field:=2, Criteria1:=.Cells(lig, "A")
            Workbooks.Add
            With ActiveWorkbook
                Wks.Range(Plage).Copy .ActiveSheet.[A1]
                .SaveAs Filename:=Chemin & .ActiveSheet.[B2].Value & ".xlsx"
                'Envoyer le mail.
                'SendEMailwithAttachments
                .Close
            End With
        Next lig
    End With
    Wks.ShowAllData
    Set Wks = Nothing
End Sub
Attention, pour le mail tu doit prendre les données sur le nouveau classeur soit..
    ActiveWorkbook.ActiveSheet
 Je ne sais pas si l'extension des nouveaux classeurs est déjà mentionner, dans ce cas supprimer & ".xlsx"
A+

VBA sur filtre répété

6 réponses

Discussions similaires

Newsletters