Ajouter feuilles nommées suivant valeurs contenues dans une colonne [Résolu]

Signaler
-
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
-
Bonjour,

je suis nouveau au forum, en faisant des recherches, j'ai trouvé ce code. je découvre VBA, j'ai fait quelque modification mais ne suis pas parvenu à adapter ce code.
En fait, je voudrai créer une macro qui vérifie que les feuilles à créer n'existent pas et si elles n'existent pas, les créer en prenant le nom des valeurs contenues dans la colonne A. les valeurs de la colonne A peuvent retrouver plusieurs fois, il faut créer et nommer la feuille qu'une seule fois.
avec ce code, on crée et on reporte des valeurs sur les feuilles. je voudrai juste créer les feuilles et les nommées.

code trouvé sur le forum:
Option Explicit
Private Sub essai1()
Dim derlig As Long, i As Integer, zone, feuilles, f As Worksheet, f_encours As String
Dim oul As Long, ouc As Long
feuilles = ""
For Each f In Worksheets
feuilles = feuilles & Chr(1) & Trim(UCase(f.Name))
Next
feuilles = UCase(feuilles & Chr(1))
derlig = Range("B" & Rows.Count).End(xlUp).Row
zone = Range("B2:I" & derlig)
For i = 1 To UBound(zone)
If InStr(feuilles, Chr(1) & Trim(UCase(zone(i, 1))) & Chr(1)) = 0 Then
With ThisWorkbook.Worksheets.Add
.Name = Trim(UCase(zone(i, 1)))
feuilles = feuilles & Trim(UCase(zone(i, 1))) & Chr(1)
DoEvents
End With
End If
f_encours = Trim(LCase(zone(i, 1)))
oul = 3
ouc = 2
If i = UBound(zone) - 1 Then Exit Sub
Do While Trim(LCase(zone(i, 1))) = f_encours And i <= UBound(zone)
If WorksheetFunction.CountIf(Worksheets(f_encours).Columns(1), zone(i, 3)) = 0 Then
Worksheets(f_encours).Range("A" & oul).Value = zone(i, 3)
oul = oul + 1
End If
If WorksheetFunction.CountIf(Worksheets(f_encours).Rows(1), zone(i, 2)) = 0 Then
Worksheets(f_encours).Cells(1, ouc).Value = zone(i, 2)
ouc = ouc + 1
End If
If i >= UBound(zone) Then Exit For
If i <UBound(zone) - 1 Then i i + 1
Loop
i = i - 1
Next
End Sub

et vous remerciant

18 réponses

Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
76
Si tu dois tester la présence d'une série de feuilles, il te suffit de répéter cette séquence à l'intérieur d'une autre boucle qui énumèreras le contenu de tes cellules + ajoutera la feuille si besoin

    Dim oSheet  As Worksheet
    Dim bTrouvé As Boolean
    Dim oRange  As Range
    
    For Each oRange In Range("A1:A200")
        If oRange.Value <> vbNullString Then
            bTrouvé = False
            For Each oSheet In ActiveWorkbook.Sheets
                If oSheet.Name = oRange.Value Then
                    bTrouvé = True
                    Exit For
                End If
            Next
            If Not bTrouvé Then
                ' Pas trouvé : on crée la feuille à la suite des autres
                Set oSheet = ActiveWorkbook.Sheets.Add(After:=Worksheets(Worksheets.Count))
                oSheet.Name = oRange.Value
            End If
        End If
    Next
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
238
Merci, excuse je suis un bleu. le code était de fcfoutu.

Et tu l'as recopié sans le comprendre, sans même savoir où l'arrêter ni quoi en prendre pour ne faire que ce qui t'intéresse, à savoir !
Dim derlig As Long, i As Integer, zone, feuilles
feuilles = ""
For Each f In Worksheets
  feuilles = feuilles & Chr(1) & Trim(UCase(f.Name))
Next
feuilles = UCase(feuilles & Chr(1))
derlig = Range("A" & Rows.Count).End(xlUp).Row
zone = Range("A1:A" & derlig)
For i = 1 To UBound(zone)
  If InStr(feuilles, Chr(1) & Trim(UCase(zone(i, 1))) & Chr(1)) = 0 Then
    With ThisWorkbook.Worksheets.Add
     .Name = Trim(UCase(zone(i, 1)))
     feuilles = feuilles & Trim(UCase(zone(i, 1))) & Chr(1)
     DoEvents
    End With
  End If
next

signé :"fcfoutu" !
Ami : le développement n'est pas la copie aveugle d'un code incompris donné ailleurs, pour une autre colonne (pire: pour toutes les cellules d'une plage à colonnes et lignes multiples !) et à d'autres fins ! Le développement est autre chose que "ça" !
________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.
Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
76
Création d'un Range de toutes les cellules non vides dans la colonne A entre la ligne 1 et la fin du classeur :
    Dim oRange As Range
    Set oRange = Range(Range("A1"), Range("A1").End(xlDown))

Ce code apparait très très très fréquemment dans les questions du forum.
Pense aussi à l'enregistreur de macro pendant que tu fais du Ctrl-Flèche-Bas.
Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
76
Salut

Pas lu ton code car illisible sans la coloration syntaxique = 3ème icone à droite.

Pour vérifier si une feuille "mon test" existe déjà :
    Dim oSheet  As Worksheet
    Dim bTrouvé As Boolean
    
    bTrouvé = False
    For Each oSheet In ActiveWorkbook.Sheets
        If oSheet.Name = "mon test" Then
            bTrouvé = True
            Exit For
        End If
    Next
    If bTrouvé Then
        MsgBox "La feuille ""mon test"" existe déjà"
    Else
        MsgBox "La feuille ""mon test"" n'existe pas"
    End If

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

Le savoir est la seule matière qui s'accroit quand on le partage (Socrate)
Merci, excuse je suis un bleu. le code était de fcfoutu.
Option Explicit
Private Sub essai1()
Dim derlig As Long, i As Integer, zone, feuilles, f As Worksheet, f_encours As String
Dim oul As Long, ouc As Long
feuilles = ""
For Each f In Worksheets
feuilles = feuilles & Chr(1) & Trim(UCase(f.Name))
Next
feuilles = UCase(feuilles & Chr(1))
derlig = Range("B" & Rows.Count).End(xlUp).Row
zone = Range("B2:I" & derlig)
For i = 1 To UBound(zone)
If InStr(feuilles, Chr(1) & Trim(UCase(zone(i, 1))) & Chr(1)) = 0 Then
With ThisWorkbook.Worksheets.Add
.Name = Trim(UCase(zone(i, 1)))
feuilles = feuilles & Trim(UCase(zone(i, 1))) & Chr(1)
DoEvents
End With
End If
f_encours = Trim(LCase(zone(i, 1)))
oul = 3
ouc = 2
If i = UBound(zone) - 1 Then Exit Sub
Do While Trim(LCase(zone(i, 1))) = f_encours And i <= UBound(zone)
If WorksheetFunction.CountIf(Worksheets(f_encours).Columns(1), zone(i, 3)) = 0 Then
Worksheets(f_encours).Range("A" & oul).Value = zone(i, 3)
oul = oul + 1
End If
If WorksheetFunction.CountIf(Worksheets(f_encours).Rows(1), zone(i, 2)) = 0 Then
Worksheets(f_encours).Cells(1, ouc).Value = zone(i, 2)
ouc = ouc + 1
End If
If i >= UBound(zone) Then Exit For
If i <UBound(zone) - 1 Then i i + 1
Loop
i = i - 1
Next
End Sub 


étant, débutant je cherche un code dans une seule macro. merci.
Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
76
As-tu seulement essayé de comprendre le code que je t'ai passé ?
Il faut commencer par là.
merci Jack, j'insiste je suis débutant alors voilà ce que j'ai compris pour le 2ème code que j'ai testé (au fait j'ai oublié de signaler que je ne connais pas à priori le nombre de valeurs contenues dans la colonne A).
1- on déclare les variables
2- on inspecte toutes les cellules de la colonne A (ligne1 à ligne200)
3- si cellule vide alors on affecte à la variable bTrouvé la valeur False
4- ensuite on inspecte toutes les feuilles du classeur et si on trouve une feuille dont le nom est égale à une valeur contenue dans la colonne A(1 à 200)(variable oRange) alors on affecte à la variable bTrouvé la valeur true et on sort de la boucle for
5- si non trouvé alors on ajoute les feuilles les unes après les autres et on leur affecte leur nom (variable oRange).

Mais ce que je n'ai pas compris c'est comment les doublons ne sont pas pris en compte? et comment faire pour étendre la colonne A jusqu'à la nième ligne contenant une valeur.
Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
76
"je voudrai juste créer les feuilles et les nommées."
C'est exactement ce que fait ce code.
Il part du principe que les noms à vérifier sont dans les cellules A1 à A200 : je te laisse le soin de le personnaliser.
Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
76
3- si cellule N'EST PAS vide alors ON COMMENCE LA RECHERCHE

Si plusieurs cellules renferment le même nom, et bien on scrutera le nom des feuilles :
La première fois, il ne la trouvera pas : On la créera.
La fois suivante, la feuille sera trouvée et on ne la créera pas.
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
238
OIuais ...
Dans un cas aussi élémentaire et aussi simple (une seule colonne à traiter) on "y va" allègrement :
Dim toto As String
For Each c In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
  On Error Resume Next
  toto = Worksheets(c.Text).Name
  If Err Then
    With ThisWorkbook.Worksheets.Add
      .Name = c.Text
    End With
  End If
  Err.Clear
Next

toujours vrai



________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
238
Et on prend (on ne sait jamais) la précaution d'éviter les cellules éventuellement vides entre la ligne 1 et la dernière ligne ===>>
Dans mon code plus haut :
If Err Then
complété par
If Err And c.Text <> "" Then




________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.
Bonjour ucfoutu, le code que j'ai mis est bien de toi, n'est-ce pas?. j'essayais de l'adapter sans y parvenir à mon cas.

Pour ce dernier code, je l'ai testé mais si je l’exécute une 2ème fois (c'est à dire les feuilles ont déjà étaient créées une première fois, il me crée encore d'autres feuilles mais en les nommant des valeurs que j'ai en colonne B.
est-ce normal?
Merci.
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
238
mais en les nommant des valeurs que j'ai en colonne B.

Pardi ! tu as copié un code qui ne traitait pas ta colonne A, mais une plage de cellules entre la colonne B et la colonne I. Et ce : sans même le voir !!!
Relis attentivement toutes mes réponses, hein ...
________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.
Messieurs, pour des chevronnés comme vous tout est évident mais pas pour un débutant. je ne suis qu'à mes << balbutiements >>.
Pour ucfoutu:
il est vrai que je n'ai pas très bien compris ton code, mais j'avais téléchargé en pièce jointe et tenter de le modifier pour créer seulement les feuilles sans données.
Pour Jack:
Si j'ai bien compris en ajoutant la ligne
Set oRange = Range(Range("A1"), Range("A1").End(xlDown))

je dois remplacer cette ligne de code
For Each oRange In Range("A1:A200")

par

For Each oRange In Range(Range("A1"), Range("A1").End(xlDown))

Messieurs, je vous remercie infiniment.
Mon cher Fcfoutu, il ne faut pas pleurer comme ça. Soit un plus indulgent avec des nuls comme moi, il faut de tout pour faire un monde.
Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
76
Eh bah super. Pas si débutant que ça !
je t'assure que je suis débutant, c'est par déduction logique que j'ai compris (initialement plage était de A1:A100), j'ai juste replacé les références de cette plage.

je te remercie beaucoup.

Si tu veux savoir, je suis un ex-pétrolier donc ma spécialité n'a rien avoir avec le développement informatique.
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
238
Si tu veux savoir, je suis un ex-pétrolier donc ma spécialité n'a rien avoir avec le développement informatique

Il se trouve que la mienne non plus. Elle n'a jamais été ma profession. Mais quand on se met à quelque chose : on s'y met.

________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.