XL 2010 [Résolu]Creation d'onglet + renommer les onglet si non existant

[gaouul]

Bonjour,

Je bute depuis cette après midi sur un petit problème de boucle.
Alors :
J'ai une liste contenue dans une feuille (Listing feuille) en colonne B.
Je dois contrôler que pour chaque cellule de ma liste si la feuille existe ou pas.
Si la feuille existe alors ne rien faire sinon créer la feuille et donner le nom de ma cellule a cette feuille.

J'ai écrit le code ci-joint et j'arrive a créer ma première feuille, la renommer proprement avec les info de la première cellule de ma liste. La seconde page ce crée et la c le drame... le debugger ce lance... et je ne comprend pas pourquoi.

Ci-joint le code utilisé :

Sub creation_feuille
    Dim mapl As Range, cel As Range, fe As Worksheet
    Set mapl = Sheets("Listing onglet").Range("B1:B" & Range("A" & Cells.Rows.Count).End(xlUp).Row)
    ActiveWorkbook.Names.Add Name:="Liste", RefersTo:=mapl
    For Each cel In mapl
        For Each fe in ThisWorkbook.Sheets
            If fe.Name = cel.Text Then
            Else
            Sheets.Add After:=Sheets("Acceuil")
            ActiveSheet.Name = cel.Text
            End If
        Next fe
    Next cel
End sub

Si j'inverse mes boucles dans mon code ca me crée bien toutes mes pages mais ca m'en rajoute quand même une à la fin et me met un message d'erreur.

Sub creation_feuille
Dim mapl As Range, cel As Range, fe As Worksheet
    Set mapl = Sheets("Listing onglet").Range("B1:B" & Range("A" & Cells.Rows.Count).End(xlUp).Row)
    ActiveWorkbook.Names.Add Name:="Liste", RefersTo:=mapl
        For Each fe In ThisWorkbook.Sheets
            For Each cel In mapl
                If fe.Name = cel.Text Then
                Else
                Sheets.Add After:=Sheets("Acceuil")
                ActiveSheet.Name = cel.Text
                End If
            Next cel
        Next fe
End sub

Pouvez vous m'aider SVP?

Merci.

 

[CHALET53]

Bonjour

Essaie de t'inspirer de cet exemple que j'avais fait pour Moristo

Pour tester : supprime une feuille dont le nom commence par 99... et lance la procédure Lance
Elle lit la liste de noms en colonne B : si elle n'existe pas, elle la crée et lui donne le nom associé
a+

 

[job75]

Bonjour gaouul, CHALET53,

Sub creation_feuille()
    Dim mapl As Range, cel As Range, x$, fe As Object
    With Sheets("Listing onglet")
        Set mapl = .Range("B1:B" & .Range("A" & .Rows.Count).End(xlUp).Row)
    End With
    mapl.Name = "Liste"
    For Each cel In mapl
        x = LCase(Left(cel, 31)) 'maximum 31 caractères
        If x <> "" Then
            For Each fe In Sheets
                If LCase(fe.Name) = x Then GoTo 1
            Next fe
            Sheets.Add After:=Sheets("Acceuil") 'en français on écrit "Accueil" !!!
            ActiveSheet.Name = Left(cel, 31)
        End If
1   Next cel
End Sub

Cela ne vous met pas à l'abri de bugs s'il y a des caractères interdits (faites une recherche à ce sujet).

A+

 

[job75]

Re,

S'il y a beaucoup de feuilles les passer en revue à chaque fois prend du temps.

On l'évite avec un contrôle d'erreur :

Sub optimisation_creation_feuille()
    Dim mapl As Range, cel As Range, x$
    With Sheets("Listing onglet")
        Set mapl = .Range("B1:B" & .Range("A" & .Rows.Count).End(xlUp).Row)
    End With
    mapl.Name = "Liste"
    On Error Resume Next 'si la feuille n'existe pas
    For Each cel In mapl
        x = Left(cel, 31) 'maximum 31 caractères
        If x <> "" Then
            If IsError(Sheets(x)) Then
                Sheets.Add After:=Sheets("Acceuil") 'en français on écrit "Accueil" !!!
                ActiveSheet.Name = x
            End If
        End If
    Next cel
End Sub

Et s'il y a des caractères interdits la feuille créée n'est simplement pas renommée, sans bug.

A+

 

[job75]

Re,

Ici s'il y a des caractères interdits la feuille créée est supprimée avec un message :

Sub optimisation_creation_feuille()
    Dim mapl As Range, cel As Range, x$
    With Sheets("Listing onglet")
        Set mapl = .Range("B1:B" & .Range("A" & .Rows.Count).End(xlUp).Row)
    End With
    mapl.Name = "Liste"
    On Error Resume Next 'si la feuille n'existe pas
    Application.DisplayAlerts = False 'si la feuille est supprimée
    For Each cel In mapl
        x = Left(cel, 31) 'maximum 31 caractères
        If x <> "" Then
            If IsError(Sheets(x)) Then
                Sheets.Add After:=Sheets("Acceuil") 'en français on écrit "Accueil" !!!
                ActiveSheet.Name = x
                If ActiveSheet.Name <> x Then
                    MsgBox "Caractère(s) interdit(s) en '" & cel.Parent.Name & "'!" & cel.Address(0, 0) & "..."
                    ActiveSheet.Delete
                End If
            End If
        End If
    Next cel
End Sub

A+

 

[gaouul]

Bonjour,

Je vous remercie tous les deux pour vos solutions.

J'ai opté pour la solution de Chalet53, qui en plus d'ajouté une page me rajoute d'autre info en fonction des colonnes renseignés.

Je vous remercie et passe cette page en [Résolu].

Bonne journée.