Erreur duplication onglets

Bonjour à tous !

J'ai pour mon boulot, dû créer une macro qui permet de dupliquer un onglet "Trame" en fonction d'une liste de clients contenus dans un tableau structuré.

Jusqu'à présent tout fonctionne bien et elle fait ce que je lui demande ^^ mais je suis tombé sur un os lors de test avec mon équipe.

En effet, quand je rajoute un client à la liste (dans le tableau structuré), et que je relance la macro pour n'ajouter au final, qu'un seul onglet de plus (après les autres), eh bien... rien ne se passe. Je pense que le problème vient du "On Error GoTo 0" mais je n'en suis pas sur et surtout je peine un peu à savoir comment corriger cela.

Je vous joint le bout de code (à défaut du fichier qui pourrait présenter des problèmes de confidentialité :( )

Public Sub CreateSheets()
Dim lo As ListObject, ws As Worksheet
Dim arrValues, sheetName As String
Dim i As Long
    Set lo = Range("TableauClients").ListObject
    For i = 1 To lo.ListRows.Count
        sheetName = lo.ListRows(i).Range.Cells(1).Value
        On Error Resume Next
        Set ws = Worksheets(sheetName)
        On Error GoTo 0
        If ws Is Nothing Then
            arrValues = lo.ListRows(i).Range.Value
            With Worksheets("Trame")
                .Cells(6, 4).Resize(2).Value = Application.Transpose(arrValues)
                .Copy after:=Worksheets(Worksheets.Count)
            End With
            ActiveSheet.Name = sheetName
        End If
    Next
    Worksheets("Trame").Cells(6, 4).Resize(2).Value = ""
    Worksheets(lo.Parent.Name).Activate
End Sub

D'avance merci pour toute l'aide que vous voudrez bien m'apporter.

Cordialement.

Bonjour,

A tester :

Public Sub CreateSheets()
Dim lo As ListObject, ws As Worksheet
Dim arrValues, sheetName As String
Dim i As Long
Set lo = Range("TableauClients").ListObject
For i = 1 To lo.ListRows.Count
sheetName = lo.ListRows(i).Range.Cells(1).Value
If Not WsExist(sheetName) Then
arrValues = lo.ListRows(i).Range.Value
With Worksheets("Trame")
.Cells(6, 4).Resize(2).Value = Application.Transpose(arrValues)
.Copy after:=Worksheets(Worksheets.Count)
End With
ActiveSheet.Name = sheetName
End If
Next
Worksheets("Trame").Cells(6, 4).Resize(2).Value = ""
Worksheets(lo.Parent.Name).Activate
End Sub
Private Function WsExist(S$) As Boolean
On Error Resume Next
WsExist = Worksheets(S).Index
End Function

Si pas Ok fournir un bout de fichier test.

A+

Hey ! Merci Galopin,

Ta réponse solutionne effectivement le problème, c'est super !!

J'avais tenté de poser une condition dans laquelle on interrogeait Excel sur la présence d'une feuille avec un nom déjà existant mais je pense qu'il me manquait la petite partie avec la fonction que tu as mise en dernier.

En tout cas merci de ta réactivité. De plus cela me permet d'apprendre comment construire mes futurs projets, c'est top.

Cordialement.