Macro Créer groupe de travail à partir liste de noms d'onglets [Résolu/Fermé]

Signaler
Messages postés
1
Date d'inscription
samedi 1 mars 2014
Statut
Membre
Dernière intervention
1 mars 2014
-
 314b -
Bonjour,
J'ai dans une colonne, une liste de noms d'onglets.
Je voudrai une macro qui me crée un groupe de travail constitué de tous ces onglets.
J'ai beau chercher, mais je n'y arrive pas
Merci d'avance à ceux qui savent ...

8 réponses

Messages postés
24043
Date d'inscription
mardi 11 septembre 2007
Statut
Contributeur
Dernière intervention
6 mai 2021
6 759
Bonjour,

Sub groupeTravail()
    Dim listeF() As String, pl As Range, c As Range, i As Long
    Set pl = [A2:A3] ' liste des noms des feuilles
    For Each c In pl
        i = i + 1
        ReDim Preserve listeF(1 To i)
        listeF(i) = c
    Next c
    Sheets(listeF).Select
End Sub 

eric
Bonjour Éric et merci pour votre prompte réponse,
Il m'a fallu un peu de temps pour comprendre.
J'ai compris et ça marche à 99,99%.
J'ai néanmoins une variable dans ma plage de noms d'onglets :
Set pl = [A2:A3] liste des noms des feuilles
C'est [A3] que j'ai mis à [A2:A2000].
La macro bug si le nombre d'onglets est inférieur à [A2000]
Je peux avoir besoin de créer des GdT dont le nombre d'onglet est variable suivant les types d'onglets que j'ai besoin de regrouper.
Hormis modifier à la main la macro pour dire le nombre de cellules non vides contenues dans ma colonne A:A (liste des onglets à grouper), je n'ai pas d'autre solution que de solliciter l'expert que vous semblez être.
Merci d'avance.
Pierre-Yves.
Messages postés
9956
Date d'inscription
mercredi 11 août 2004
Statut
Contributeur
Dernière intervention
4 mai 2021
1 138
Bonjour,
Au passage insérer la ligne d'instruction qui détecte la variable vide juste après For Each...
If c Is Nothing Then Exit Sub

Messages postés
24043
Date d'inscription
mardi 11 septembre 2007
Statut
Contributeur
Dernière intervention
6 mai 2021
6 759
Exit For suffira le pingou ;-)

Autre méthode qui s'assure en plus que chaque nom correspond bien à un nom de feuille existante :
Sub groupeTravail()
    Dim listeF() As String, pl As Range, c As Range, i As Long
    Dim a As String
    Set pl = [A2:A10]    ' liste des noms des feuilles
    For Each c In pl
        On Error GoTo fin
        a = Worksheets(c.Value).Name
        On Error GoTo 0
        i = i + 1
        ReDim Preserve listeF(1 To i)
        listeF(i) = c
    Next c
fin:
    Sheets(listeF).Select
    ' mettre une ' au début de la ligne suivante pour l'inactiver
    MsgBox i & " feuilles sélectionnées." & vbLf _
        & "Dernière feuille : " & listeF(UBound(listeF))
End Sub

eric
Messages postés
9956
Date d'inscription
mercredi 11 août 2004
Statut
Contributeur
Dernière intervention
4 mai 2021
1 138
Bonjour eriiic,
Merci, un manque d'attention de ma part.
Je profite en plus de votre excellente solution.
Bon dimanche.
Amicales salutations.
Le Pingou
Messages postés
24043
Date d'inscription
mardi 11 septembre 2007
Statut
Contributeur
Dernière intervention
6 mai 2021
6 759
Et oui, ne pas hésiter à provoquer des erreurs et s'en servir.
Depuis le temps on peut se tutoyer non ? :-)
Bonne soirée (nuit...)
eric
Messages postés
9956
Date d'inscription
mercredi 11 août 2004
Statut
Contributeur
Dernière intervention
4 mai 2021
1 138
Bonjour eriiic,
Mais bien sur que oui, tu vois c'est aussi du au manque d'attention/fatigue....!
Amicales salutations.
Le Pingou
Le Pingou, Éric,
Merci à vous deux,
Mais ni l'une ni l'autre de vos solutions atteind son but :
Elles bug sur la dernière ligne de la macro :
Sheets(CréerGroupedeTravail).Select
Voici où j'en suis, en ayant personnalisé la macro d'Éric à mon fichier, et après avoir fait un filtre dans l'onglet "Liste Salariés" et après avoir sélectionner les cellules contenant la liste des onglets que je veux grouper:

Sub Groupe_Travail()
'
' Groupe_Travail Macro
'
' Touche de raccourci du clavier: Ctrl+g
'
Sheets("CréerGroupedeTravail").Select
Range("B4:B2003").Select
Selection.ClearContents
Sheets("Liste Salariés").Select
Selection.Copy
Sheets("CréerGroupedeTravail").Select
Range("B4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select

Dim CréerGroupedeTravail() As String, pl As Range, c As Range, i As Long
Set pl = [B4:B2003] ' liste des noms des feuilles
For Each c In pl
Exit For
i = i + 1
ReDim Preserve CréerGroupedeTravail(1 To i)
CréerGroupedeTravail(i) = c
Next c
Sheets(CréerGroupedeTravail).Select

End Sub

Je maintiens qu'elle fonctionne bien si je modifie B2003, dans la ligne :
Set pl = [B4:B2003] ' liste des noms des feuilles
par
Set pl = [B4:" le NBVAL(B4:B2003) "]
sauf que je ne sais pas paramétrer cette variable dans cette ligne.

À vous de jouer ! Et encore merci d'avance.
Messages postés
24043
Date d'inscription
mardi 11 septembre 2007
Statut
Contributeur
Dernière intervention
6 mai 2021
6 759
Je n'y voit pas le dernier code que j'ai mis.
Mais une grossière erreur :
For Each c In pl
Exit For

Si tu sors tout de suite tu crois que ta boucle va beaucoup travailler ?

Si tu pouvais tester le code que je te propose tout seul.

eric

Éric, bonjour et un très grand MERCI
J'ai fait comme Tu m'as dit ci-dessus...
(c'est sympa la MsgBox)
Ça marche comme je veux ; c'est Super !
Messages postés
24043
Date d'inscription
mardi 11 septembre 2007
Statut
Contributeur
Dernière intervention
6 mai 2021
6 759
Pour compléter la msgbox, remplacer par :
    MsgBox i & " feuilles sélectionnées." & vbLf _
        & "Dernière feuille : " & listeF(UBound(listeF)) _
        & IIf(Err = 9 And c <> "", vbLf & vbLf & "Arrêt sur feuille inconnue en ligne " _
        & c.Row & " : " & c, "")

Si l'arrêt est provoqué par un nom de feuille inconnu, t'annonce sa ligne et son nom.

eric
Bonjour Éric,
J'ai pris en compte ta dernière mouture MsgBox, qui est très bien !
Merci encore pour l'aide que tu as apportée au bricolo que je suis.
C'est la 1ère fois que je pose une question sur CCM.
C'est sûr que j'y reviendrais ...