Ajouter feuilles nommées suivant valeurs contenues dans une colonneRésolu

Question

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

cs_Jack · Accepted Answer

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

cs_Jack · Answer

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)

scribetout · Answer

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.

cs_Jack · Answer

As-tu seulement essayé de comprendre le code que je t'ai passé ?
Il faut commencer par là.

ucfoutu · Answer

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.

scribetout · Answer

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.

cs_Jack · Answer

"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.

cs_Jack · Answer

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.

ucfoutu · Answer

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.

cs_Jack · Answer

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.

ucfoutu · Answer

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.

scribetout · Answer

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&#8217;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.

ucfoutu · Answer

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.

scribetout · Answer

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.

scribetout · Answer

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.

cs_Jack · Answer

Eh bah super. Pas si débutant que ça !

scribetout · Answer

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.

ucfoutu · Answer

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.

Ajouter feuilles nommées suivant valeurs contenues dans une colonne

18 réponses

Votre réponse

Discussions similaires