VBA sur filtre répété

naniecouette -
lermite222 Messages postés 8724 Date d'inscription Statut Contributeur Dernière intervention - 6 janv. 2013 à 23:29

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.

Afficher la suite

A voir également:

VBA sur filtre répété
Photo filtre 7 gratuit - Télécharger - Retouche d'image
Filtre whatsapp - Accueil - Messagerie instantanée
Filtre teams - Accueil - Visio
Filtre manga - Accueil - TikTok
Excel compter cellule couleur sans vba - Guide

6 réponses

Réponse 1 / 6

lermite222 Messages postés 8724 Date d'inscription Statut Contributeur Dernière intervention 1 191

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+

Réponse 2 / 6

Naniecouette

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.

Réponse 3 / 6

eriiic Messages postés 24603 Date d'inscription Statut Contributeur Dernière intervention 7 275

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

Réponse 4 / 6

lermite222 Messages postés 8724 Date d'inscription Statut Contributeur Dernière intervention 1 191

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+

eriiic Messages postés 24603 Date d'inscription Statut Contributeur Dernière intervention 7 275

Salut lermite,

comme tu ne revenais pas je me suis permis... :-s
eric

lermite222 Messages postés 8724 Date d'inscription Statut Contributeur Dernière intervention 1 191

Pas de souci Eric, bien au contraire, tu m'a fais retrouver cette foutue fonction.
Amicalement.

lermite222 Messages postés 8724 Date d'inscription Statut Contributeur Dernière intervention 1 191

Pour info,
@Eric,
Tu sais que [Feuil2!A1] et [Feuil2] pourraient êtres des feuilles différentes ?
[Feuil2!A1] fait référence à Sheets("Feuil2").Range("A1")
Alors que [Feuil2] fait référence au N° d'ordre de la feuille et qu'il pourrait être différent du nom de la feuille
Si tu renomme la feuille "Feuil2" par "Test" tu a dans l'explorateur de projet
Feuil2 (Test)
[Feuil2!A1] devra être renommer [Test!A1]
alors que [Feuil2] ne devra pas être changer.
A+

eriiic Messages postés 24603 Date d'inscription Statut Contributeur Dernière intervention 7 275

Salut lermite,

m... tu as raison.
Je pensais que mettre les crochets était suffisant pour désigner le nom mais [Feuil2], n'est pas le raccourci de worksheets("Feuil2").
[Feuil2].Range("A1") est équivalent à Feuil2.Range("A1") et fait référence au codename.
Pas très logique ça et pas de raccourcis, les traitres... ;-)

Merci de me l'avoir signalé , heureusement qu'il n'y pas très longtemps que j'ai tenté cette écriture.
eric

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 5 / 6

Naniecouette

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.

eriiic Messages postés 24603 Date d'inscription Statut Contributeur Dernière intervention 7 275

Bonjour,

Tu peux rester sur le code du post 3, l'avantage c'est que si tu renommes ta feuille il fonctionnera toujours sans le modifier.
Mais lermite a bien fait de faire cette remarque car il a vu que j'avais autre chose en tête. Cette erreur n'est pas dérangeante ici, elle arrange même :-)

eric

Réponse 6 / 6

lermite222 Messages postés 8724 Date d'inscription Statut Contributeur Dernière intervention 1 191

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+

Discussions similaires

"L'indice n'appartient à la sélection" + VBA

Erreur d'exécution 13 Incompatibilité de type

Excel ne filtre pas les derniere donnée ecrite

La fonction FILTRE n'est plus reconnue

comment contourner la fonction FILTRE

Votre réponse

Discussions similaires