VBA - Si nom de la feuille existe then nom de la feuille créée

Hello cher forum ,

J'aimerais écrire une macro qui créé un nouvel onglet dont le nom sera = à la cellule B1. Cependant, si un onglet existe déjà avec ce nom =cells(B1) alors le nom sera B1&" -2".
Rien de très compliqué en apparence. Pourtant quand je tente le doublon, on me met le message suivant au lieu de me créer un onglet avec le titre =B1& " -2".

Voici mon code :

Sub new_sheet()

Dim Sh As Variant, FeuilleExiste As Boolean

For Each Sh In Worksheets
    If Sh.Name = Sheets("Base").Range("A2").Value Then _
    FeuilleExiste = True Else FeuilleExiste = False
Next Sh

    If FeuilleExiste = True Then _
    Sheets.Add(after:=Worksheets(1)).Name = Sheets("Base").Range("B1").Value & " -2" Else
    Sheets.Add(after:=Worksheets(1)).Name = Sheets("Base").Range("B1").Value

End Sub

Merci d'avance pour toute aide de votre part, je débute en VBA et j'ai beaucoup à apprendre.

Cordialement

Oups, pardon mon code est le suivant avec ci-joint le fichier :

Sub new_sheet()

Dim Sh As Variant, FeuilleExiste As Boolean

For Each Sh In Worksheets
    If Sh.Name = Sheets("Base").Range("B1").Value Then _
    FeuilleExiste = True Else FeuilleExiste = False
Next Sh

    If FeuilleExiste = True Then _
    Sheets.Add(after:=Worksheets(1)).Name = Sheets("Base").Range("B1").Value & " -2" Else
    Sheets.Add(after:=Worksheets(1)).Name = Sheets("Base").Range("B1").Value

End Sub

Salut Temprano,

quelque chose ainsi ?
La macro démarre sur un double-clic en [B1]

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
If Not Intersect(Target, [B1]) Is Nothing Then
    Cancel = True
    On Error Resume Next
    If Worksheets(CStr([B1])) Is Nothing Then
        Sheets.Add(after:=Worksheets(1)).Name = [B1]
    Else
        If Worksheets(CStr([B1]) & " -2") Is Nothing Then
            Sheets.Add(after:=Worksheets(CStr([B1]))).Name = [B1] & " -2"
        Else
            MsgBox "La feuille " & [B1] & " -2" & " existe déjà !"
        End If
    End If
    On Error GoTo 0
End If
'
End Sub

A+

Salut Curulis, merci beaucoup une fois de plus tu me sauves la mise

ça fonctionne parfaitement !!

Salut à tous,

Pour ne pas réinventé la roue ....

Dans votre module FonctionsXLS par exemple où vous stockez toutes vos fonctions...

Option Explicit
'————————   ENUMERATION POUR RENAMEWITHINCREMENT   —————————————
Public Enum vaIncrement
    Fichier = 0
    Feuille = 1
End Enum

' Procedure    :  RenameWithIncrement
' Date         :  14/07/2017
' Auteur       :  Jean-Paul (Valtrase)
' Site         :
' Adaptation   :  Jean-Paul (Valtrase)
' Révision     :  17/06/2021
' Objectif     :  Remonmer un fichier ou une feuille avec incrémentation
' Référence    :
' Entrée       :  Le nom de la feuille ou du fichier
' Sortie       :  Le nom de la feuille renommé ou False sur erreur
' Note         :  Dans le cas d'un fichier entrez le chemin complet
' Exemple      :  RenameWithIncrement Feuille1, Sheet      Retour : Feuille1(1)
Public Function RenameWithIncrement(EntryName As String, _
                                     Optional EntryType As vaIncrement = Fichier _
                                     )

Dim Index As Byte, strNameTemp As String
Dim SheetExiste As Boolean
Dim sh As Worksheets

    Index = 1
    strNameTemp = EntryName

    Select Case EntryType
        Case Feuille
            While SheetExist(strNameTemp)
                strNameTemp = EntryName & "(" & Index & ")"
                Index = Index + 1
            Wend

        Case Fichier
            While Dir(strNameTemp) <> ""
                strNameTemp = EntryName & "(" & Index & ")"
                Index = Index + 1
            Wend
        Case Else

    End Select
    RenameWithIncrement = strNameTemp

End Function

' Procedure : SheetExist
' Date      : 15/12/2016
' Auteur    : JeanPaul
' Objectif  : Tester si une feuille existe
' Entrée    :
' Sortie    : True ou False
' Note      :
' Exemple   :       Retour :
Public Function SheetExist(ByVal stFeuille) As Boolean
    On Error Resume Next

    SheetExist = Not (ThisWorkbook.Sheets(stFeuille) Is Nothing)
    '    ' // Ou pour les purristes
    '    Dim bolExist As Boolean, sh As Worksheet
    '    For Each sh In ThisWorkbook.Worksheets
    '        If stFeuille = sh.Name Then bolExist = True
    '    Next
    '    SheetExist = bolExist
End Function

Et pour l'appel :

 ThisWorkbook.Worksheets.Add(after:=Worksheets(1)).Name = _
    RenameWithIncrement(Worksheets("Base").Range("B1").Value, Feuille)