Problème pour faire une boucle avec l'autofilter en VBA

Fermé
jubo26 Messages postés 1 Date d'inscription dimanche 2 décembre 2012 Statut Membre Dernière intervention 2 décembre 2012 - 2 déc. 2012 à 23:02
mateo44 Messages postés 11 Date d'inscription jeudi 7 avril 2016 Statut Membre Dernière intervention 18 avril 2016 - 15 avril 2016 à 16:12
Bonjour,


Voilà, je veux faire une boucle avec un autofilter sous VBA.
Cet autofilter doit filtrer uniquement sur une seule colonne.
Cette boucle doit à chaque fois filtrer chaque élément de cette colonne.

Par exemple

Ci-dessous, il y a 2 colonnes, je voudrais faire un filtre sur la colonne Service
La boucle doit prendre chaque élément pour les filtrer (DAF, DI, DRH)


Service Prénom
DAF Claudia
DAF Jean
DAF Paul
DI Thierry
DI Richard
DI Jean Marc
DAF Paul
DRH Gabriel
DAF Sylvain
DI Thierry
DRH Michelle
DAF Richard

En faite, l'objectif de cette manipulation est de copier coller le nom et le service dans un fichier par service. C'est pour ça que j'ai besoin de faire une boucle et d'utiliser l'autofilter.

Là je sais le faire pour 3 variables mais je vais en avoir une centaine! Du coup comment pourrais-je faire pour que l'autofilter sélectionne directement chaque élément de la colonne?
Merci pour votre aide

Julien

3 réponses

eriiic Messages postés 24570 Date d'inscription mardi 11 septembre 2007 Statut Contributeur Dernière intervention 23 avril 2024 7 213
3 déc. 2012 à 00:01
Bonsoir,

Tant qu'à faire du vba autant créer les classeurs directement :
Sub CréerFichiers()
    Const rep As String = "D:\tmp\"
    Dim nblig As Long, service As String
    Dim sh As Worksheet
    Set sh = Worksheets("Feuil1")
    ' trier liste
    Columns("A:B").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes
    Do While [A2] <> ""
        service = [A2]
        nblig = WorksheetFunction.CountIf([A:A], [A2])
        ' créer fichier
        Workbooks.Add
        ' titre col
        sh.[A1:B1].Copy [A1:B1]
        ' données
        sh.[A2].Resize(nblig, 2).Copy [A2].Resize(nblig, 2)
        sh.[A2].Resize(nblig, 2).Delete Shift:=xlUp
        ' sauver fichier
        Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs Filename:=rep & service & ".xls", FileFormat:=xlNormal
        Application.DisplayAlerts = True
        ActiveWorkbook.Close
    Loop
End Sub

Ce n'est pas le plus rapide mais vu les temps d'écritures des fichiers et l'heure qu'il est j'ai fait au plus simple.

Travailler sur une copie, les données sont supprimées...
Le répertoire de destination doit exister. (à changer dans la constante rep)
Si un fichier y est existant il sera remplacé par le nouveau créé.

https://www.cjoint.com/?BLdaaDzMNaL

eric

0
Merci beaucoup Eric :-)
0
eriiic Messages postés 24570 Date d'inscription mardi 11 septembre 2007 Statut Contributeur Dernière intervention 23 avril 2024 7 213
4 déc. 2012 à 00:01
ok, je met en résolu pour toi (en haut vers ton titre, pour la prochaine fois)
eric
0
mateo44 Messages postés 11 Date d'inscription jeudi 7 avril 2016 Statut Membre Dernière intervention 18 avril 2016
15 avril 2016 à 16:12
Bonjour,

J'aimerais savoir s'il était possible d'avoir des précisions sur le code..

J'ai la même tâche à faire avec des numéro de groupes à filtrer en colonne B, mais j'ai plus de 15 colonnes à côté contrairement à l'exemple ci-dessus.

15 colonnes, 428 lignes pour être précis, la colonne B comprend des numéro de groupes allant de 101 à 116 (16 groupes).

Merci par avance ..
0