Enchainer des copier apres autofilter

[almas]

Bonjour le forum

j 'essais de bricoler un code pour fabriquer un devis auto

j 'ai réussis a faire mes extraction et coller mais à des ligne fixes

je voudrais que les copier s 'enchaine en fonction du nombre de ligne du précédent

étant novice en code peut être que je ne n 'ai pas les choses par le bon bout!^^

il faudrait également que les titres de chaque section reste ....

merci d 'avance de m 'aider

 

[vgendron]

Re : Enchainer des copier apres autofilter

Bonjour,

ouh laaa.. pas claire du tout ta demande..

à partir de ta base.. tu souhaites copier quoi en fonction de quel critère?

les copier s'enchaine (nt) en fonction du nombre de ligne (s) du précédent..???

quels copiers? quel précédent?,

Ton besoin ne serait il pas:
pour chaque service de la colonne E (onglet Base) tu veux récuperer tous les matériels (colonne A) pour lesquels il y a une valeur dans la colonne B ??

 

[vgendron]

Re : Enchainer des copier apres autofilter

Re,

avec ce code. par exemple

Sub Macro3()
'
' Macro3 Macro
'

For Each critere In Range("ListeServices")
    'filtre sur le critère colonne E
    ActiveSheet.Range("$A$7:$E$170").AutoFilter Field:=5, Criteria1:=critere
    'filtre sur la colonne B
    ActiveSheet.Range("$A$7:$E$170").AutoFilter Field:=2, Criteria1:="<>"
    
    'copie des lignes affichées
    Sheets("Devis2").Range("A" & Sheets("Devis2").Range("A:A").Rows.Count).End(xlUp).Offset(1, 0) = "Service " & critere
    Range("A8:E170").SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("Devis2").Range("A" & Sheets("Devis2").Range("A:A").Rows.Count).End(xlUp).Offset(1, 0)
       
Next critere

End Sub

NB: j'ai créé un onglet Devis2 pour garder ton onglet Devis en exemple
dans l'onglet base, j'ai créé une zone nommée (ListeServices) qui contient tous les services possibles

il faudra ensuite faire une mise en forme pour les titres
ainsi que prévoir d'intégrer des lignes entre les services.
mais la. c'est juste pour le principe ;-)

 

[almas]

Re : Enchainer des copier apres autofilter

merci vgendron c 'est ce que je voulais

je voudrai bien comprendre ton code pour pouvoir le refaire moi même ou l 'adapter

-tu a créé une liste des critères nommé "ListeServices"

puis ici tu déclare "critere" en ListeService
For Each critere In Range("ListeServices")

ici c 'est les autofilter : 1 selon critère et l'autre fixe
'filtre sur le critère colonne E
ActiveSheet.Range("$A$7:$E$170").AutoFilter Field:=5, Criteria1:=critere
'filtre sur la colonne B
ActiveSheet.Range("$A$7:$E$170").AutoFilter Field:=2, Criteria1:="<>"

ici si j 'ai bien compris tu incorpore la ligne titre selon la liste "ListeService"a la 1ere ligne libre
Sheets("Devis2").Range("A" & Sheets("Devis2").Range("A:A").Rows.Count).End(xlUp).Offset(1, 0) = "Service " & critere

cette ligne je l 'ai pas trop comprise-je pense que c' est la que tu récupérè le résultat de l autofilter et que tu le colle a la 1er ligne vide

Range("A8:E170").SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("Devis2").Range("A" & Sheets("Devis2").Range("A:A").Rows.Count).End(xlUp).Offset(1, 0)

enfin ça c 'est la boucle mais il y a pas besoins de lui préciser d 'arrêter a la fin de la liste?
Next critere

voila dit moi si je suis dans le vrais SVP et pour les lignes de copies j 'ai un problème pour comprendre quelle partie "sélectionne" et quel partie "trouve la 1er libre" et quel partie "colle"

en faite pour savoir ou rajouter les mise en forme des titres par exemple

merci d 'avance

 

[vgendron]

Re : Enchainer des copier apres autofilter

Hello

bah en fait, je crois que tu as déjà tout bien compris

dans la feuille Base, j'ai nommé une zone (J2:J7) "ListeServices"
à gauche de la zone de saisie de formule, clique sur la petite flèche, puis sélectionne "ListeServices"
tu vas, voir. excel selectionne automatiquement la zone dans l'onglet

For Each critere In Range("ListeServices")
"Critere", c'est une variable que j'utilise sur CHAQUE élément de la zone nommée

ici c 'est les autofilter : 1 selon critère et l'autre fixe:
'filtre sur le critère colonne E
ActiveSheet.Range("$A$7:$E$170").AutoFilter Field:=5, Criteria1:=critere
'filtre sur la colonne B
ActiveSheet.Range("$A$7:$E$170").AutoFilter Field:=2, Criteria1:="<>"

EXACTEMENT


dans la feuille Devis 2, je mets la ligne de titre: Service + Contenu de la variable critère

Sheets("Devis2").Range("A" & Sheets("Devis2").Range("A:A").Rows.Count).End(xlUp ).Offset(1, 0) = "Service " & critere

Sheets("Devis2").Range("A:A").Rows.Count

récupère le numéro de la dernière ligne de la colonne A: en excel 2003, je crois que c'est 65536: c'est le nombre MAX d'une feuille excel

Range("A" & Sheets("Devis2").Range("A:A").Rows.Count)

je me place donc sur la cellule A65536
.end(xlup)
je remonte vers la première ligne Non vide: à la première itération de la boucle (sur le premier critère), ca sera A1
.offset(1,0): je descend d'une ligne: donc A2

donc ici. en A2, j'ai mis "Service transport"
c'est donc maintenant qu'il faut intervenir pour la mise en forme du titre

Range("A8:E170").SpecialCells(xlCellTypeVisible).C opy
je ne copie ici que les lignes visibles (celles qui résultent du tri)

destination..... idem que pour le titre


enfin ça c 'est la boucle mais il y a pas besoins de lui préciser d 'arrêter a la fin de la liste?
Next critere
c'est déjà fait avec for EACH..

 

[vgendron]

Re : Enchainer des copier apres autofilter

Re,

Voici une nouvelle version avec deux modifs:

1) Coloration des titres dans l'onglet Devis2
2) création d'une ListeServices2: cette liste est créée par formule et mise à jour dynamiquement
la ListeServices: j'avais juste fait un copier coller des services que j'ai sélectionnés manuellement
et dans le gestionnaire de nom: ListeServices était déclaré juste avec =J2:J9
la limitation de ceci, c'est que si tu rajoutes des services dans ton tableau, il faudra mettre à jour manuellement la liste en copiant collant les nouveaux services et puis aller dire à Excel que la liste n'est plus J2:J9 mais J2:J11 (si 2 services de plus)

alors que ListeServices2: c'est une formule matricielle qui fait une extraction sans doublon de la colonne E
donc.. si tu rajouttes des services. la table en K se mettra à jour (d'ailleurs, c'est pour ca que NON UTILISE apparait)
et dans le gestionnaire de noms, Excel s'autodémerde pour ajuster les bornes de cette zone


Voila ;-)
à ton service

 

[almas]

Re : Enchainer des copier apres autofilter

super explication merci beaucoup

par contre je bug quand un des critères n 'a pas de sortie........

et je sais pas ou mettre Selection.AutoFilter Field:=2 et Selection.AutoFilter Field:=5 pour enlever les filtres sur la base

 

[vgendron]

Re : Enchainer des copier apres autofilter

ah oui.. pardon.
suffit de rajouter une ligne: On error resume next

Sub Macro3()
'
' Macro3 Macro
'
'pour chaque cellule de la zone "ListeServices2"
For Each critere In Range("ListeServices2")
    'si on a le critère "NON UTILISE", alors, on ne fait rien et on passe au critère suivant
    If critere <> "NON UTILISE" Then
        'filtre sur le critère colonne E
        ActiveSheet.Range("$A$7:$E$170").AutoFilter Field:=5, Criteria1:=critere
        'filtre sur la colonne B
        ActiveSheet.Range("$A$7:$E$170").AutoFilter Field:=2, Criteria1:="<>"
    
        'copie des lignes affichées
        With Sheets("Devis2").Range("A" & Sheets("Devis2").Range("A:A").Rows.Count).End(xlUp).Offset(2, 0)
            'on écrit "Service" et contenu de critere
            .Value = "Service " & critere
            'on colorie de la meme couleur que le critère sélectionné dans la listeService
            .Interior.ColorIndex = critere.Interior.ColorIndex
        End With
        'on copie colle les lignes visibles uniquement (celles résultant du filtre)
        On Error Resume Next
        Range("A8:E170").SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("Devis2").Range("A" & Sheets("Devis2").Range("A:A").Rows.Count).End(xlUp).Offset(1, 0)
    End If
Next critere
    ActiveSheet.Range("$A$7:$E$170").AutoFilter Field:=5
    ActiveSheet.Range("$A$7:$E$170").AutoFilter Field:=2
End Sub

et les autofilter 5 et 2 à la fin de la boucle

 

[almas]

Re : Enchainer des copier apres autofilter

ta nouvel version bug a l exécution

ici:.Value = "Service " & critere

 

[vgendron]

Re : Enchainer des copier apres autofilter

ha..

est ce que Excel 2003 connait la fonction Decaler?
si oui. je vois pas ou est le problème.
si non. effectivement. dans ce cas. Excel ne doit pas savoir créér la zone ListeServices2, auquel cas. la macro est perdue..

si c'est ca. faut revenir avec la ListeServices..

 

[almas]

Re : Enchainer des copier apres autofilter

ok et je met la mis en forme des titre dans la macro au lieux de coller avec la mise en forme de liste2
c 'est ca?

comment je peut faire pour appliquer également aux titres la notion de "critère non utilisé"
en claire que les titres sois copier que si il a des choses en dessous ^^

j 'ai tester plein de truc mais pas moyen

 

[vgendron]

Re : Enchainer des copier apres autofilter

remplace cette ligne

If critere <> "NON UTILISE" Then

par

If critere <> "NON UTILISE" and critere<>"" Then

et si tu veux que le critere Non utilisé soit pris en compte aussi
et bien tu remplaces par ceci

If critere<>"" Then

 

[almas]

Re : Enchainer des copier apres autofilter

je te remercie vgendron de m'aider comme ca

je viens de voir qu il y avais une confusion car j 'avais une cellule avec écrit "non utilisé"
mais je parlais en faite d ' un critère (service ) ou il n' y avais pas de sortie

j 'ai bricoler encore ton code(suppression des lignes/taille de police/suppression de la dernière colonne) mais pas moyen de ne pas copier les titres des service sans sorties

 

[vgendron]

Re : Enchainer des copier apres autofilter

héhé. j'avais pas compris que tu ne voulais pas les entetes des services "vides"

donc..voici

Sub Macro3()
'
' Macro3 Macro
''supprimer toute les lignes de l' onglet devis
Sheets("Devis2").Select
Rows("1:500").EntireRow.Delete Shift:=xlUp
Sheets("Base").Select
'pour chaque cellule de la zone "ListeServices"
For Each critere In Range("ListeServices")
    'si on a le critère "NON UTILISE", alors, on ne fait rien et on passe au critère suivant
    If critere <> "" Then
        'filtre sur le critère colonne E
        ActiveSheet.Range("$A$7:$E$170").AutoFilter Field:=5, Criteria1:=critere
        'filtre sur la colonne B
        ActiveSheet.Range("$A$7:$E$170").AutoFilter Field:=2, Criteria1:="<>"
        
        'on continue uniquement si le résultat des filtres donne quelque chose à copier
        If Application.Subtotal(2, Columns(2)) <> 0 Then
            'copie des lignes affichées
            With Sheets("Devis2").Range("A" & Sheets("Devis2").Range("A:A").Rows.Count).End(xlUp).Offset(2, 0)
                'on écrit "Service" et contenu de critere
                .Value = "Service " & critere
                'on colorie de la meme couleur que le critère sélectionné dans la listeService
                .Interior.ColorIndex = critere.Interior.ColorIndex
                'on garde de la meme taille de police que le critère sélectionné dans la listeService
            .Cells.Font.Size = critere.Cells.Font.Size
            End With
            'on copie colle les lignes visibles uniquement (celles résultant du filtre)
            On Error Resume Next
            Range("A8:D170").SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("Devis2").Range("A" & Sheets("Devis2").Range("A:A").Rows.Count).End(xlUp).Offset(1, 0)
        End If
    End If
Next critere
    ActiveSheet.Range("$A$7:$E$170").AutoFilter Field:=5
    ActiveSheet.Range("$A$7:$E$170").AutoFilter Field:=2
End Sub

 

[almas]

Re : Enchainer des copier apres autofilter

merci beaucoup!