Sheets met zelfde naam, een numering geven.

[bgoo]

Als een sheet dezelfde naam heeft, bij het maken van een automatisch blad, geeft hij een error. Ik heb de goed code voor als het 1x gebeurd, dan komt er een "(2)" achter de naam, maar dit is helaas niet voor oneindig.

Sub Nieuwebon_lid()
Dim Snaam As String
Dim isheet As Integer

ActiveWorkbook.Unprotect Password:="wsv"
    
Sheets("ZZ NieuweBonLid").Copy , Sheets(Sheets.Count)
Snaam = (Worksheets("ZZZ MENU").Range("F7").Value)
For isheet = 1 To Sheets.Count
If Sheets(isheet).Name = Snaam Then
Snaam = (Worksheets("ZZZ MENU").Range("F7").Value & "(2)")
End If
Next
      With ActiveSheet
           .Name = Snaam
           .Range("B3").Value = "Naam: " & Worksheets("ZZZ MENU").Range("F7").Value
           .Range("E3") = Worksheets("ZZZ MENU").Range("F8").Value
      End With
   
ActiveWorkbook.Protect Password:="wsv"

End Sub

Bij voorbaat dank!

 

[Roncancio]

Sub Nieuwebon_lid()
Dim sNaam As String
Dim isheet As Integer
Dim iTeller As Integer

    ActiveWorkbook.Unprotect Password:="wsv"
        
    Sheets("ZZ NieuweBonLid").Copy , Sheets(Sheets.Count)
    sNaam = (Worksheets("ZZZ MENU").Range("F7").Value)
    For isheet = 1 To Sheets.Count
        If Sheets(isheet).Name = sNaam Then iTeller = iTeller + 1
    Next

    With ActiveSheet
         .Name = sNaam & "(" & iTeller + 1 & ")"
         .Range("B3").Value = "Naam: " & sNaam
         .Range("E3") = Worksheets("ZZZ MENU").Range("F8").Value
    End With
   
ActiveWorkbook.Protect Password:="wsv"

End Sub

Met vriendelijke groet,


Roncancio

 

[mart37]

    Sheets("ZZ NieuweBonLid").Copy , Sheets(Sheets.Count)
    sNaam = (Worksheets("ZZZ MENU").Range("F7").Value)
    If Evaluate("isref('" & sNaam & "'!A1)") Then
        Do
            iTeller = iTeller + 1
            nNaam = sNaam & "(" & iTeller & ")"
        Loop While Evaluate("isref('" & nNaam & "'!A1)")
        sNaam = nNaam
    End If
    With ActiveSheet
         .Name = sNaam
         .Range("B3").Value = "Naam: " & sNaam
         .Range("E3") = Worksheets("ZZZ MENU").Range("F8").Value
    End With

 

[bgoo]

Hartelijk dank !