Soru Sekmelere isim verme kodumda aynı isim varsa xxx-2 desin

[euphrates55]

aşağıdaki kod, her sekmedeki T1 hücresine göre sekmeye isim veriyor.
sorum ise; aynı isim varsa hata veriyor. bunu aynı isime denk gelince xxx-2 xxx-3 gibi isimlendirmesi için bir şey yapılabilir mi?

Sub RenameTabs()
 For x = 1 To Sheets.Count
 If Worksheets(x).Range("T1").Value <> "" Then
 Sheets(x).Name = Worksheets(x).Range("T1").Value
 End If
 Next
 End Sub

 

[Muzaffer Ali]

Merhaba.
Aşağıdaki kodları kullanabilirsiniz.

Sub RenameTabs()
    Dim x As Integer
    Dim No As Integer
    Dim Ek As String
    For x = 1 To Sheets.Count
        If Worksheets(x).Range("T1").Value <> "" Then
1:
            On Error Resume Next
            Sheets(x).Name = Worksheets(x).Range("T1").Value & Ek
            Ek = ""
            
            If Err.Number = 0 Then
                No = 0
            ElseIf Err.Number = 1004 Then
                No = No + 1
                Ek = "-" & No
                GoTo 1
            End If
        End If
    Next
End Sub

 

[euphrates55]

Merhaba.
Aşağıdaki kodları kullanabilirsiniz.

Sub RenameTabs()
    Dim x As Integer
    Dim No As Integer
    Dim Ek As String
    For x = 1 To Sheets.Count
        If Worksheets(x).Range("T1").Value <> "" Then
1:
            On Error Resume Next
            Sheets(x).Name = Worksheets(x).Range("T1").Value & Ek
            Ek = ""
           
            If Err.Number = 0 Then
                No = 0
            ElseIf Err.Number = 1004 Then
                No = No + 1
                Ek = "-" & No
                GoTo 1
            End If
        End If
    Next
End Sub

teşekkürler. sorunsuz

 

[euphrates55]

Merhaba.
Aşağıdaki kodları kullanabilirsiniz.

Sub RenameTabs()
    Dim x As Integer
    Dim No As Integer
    Dim Ek As String
    For x = 1 To Sheets.Count
        If Worksheets(x).Range("T1").Value <> "" Then
1:
            On Error Resume Next
            Sheets(x).Name = Worksheets(x).Range("T1").Value & Ek
            Ek = ""
           
            If Err.Number = 0 Then
                No = 0
            ElseIf Err.Number = 1004 Then
                No = No + 1
                Ek = "-" & No
                GoTo 1
            End If
        End If
    Next
End Sub

bu koda 31 karakter sorunu için ve yasak işaretlemeler için nasıl sınırlama getirebiliriz.

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub RenameTabs()
    Dim X As Long, Y As Byte, Yasak_Karakterler As Variant
    Dim Yeni_Karakter As Variant, Sayfa_Adi As String, Ek As Integer
    
    Yasak_Karakterler = Array("/", "\", "?", "[", "]")
    
    Yeni_Karakter = Application.InputBox("Yasaklı karakterleri ne ile değiştirmek istersiniz?", "Yasaklı Karakter Değişimi")
    If Yeni_Karakter = False Or Yeni_Karakter = "" Then
        MsgBox "İşleme devam edebilmeniz yasaklı karakter değişimi için giriş yapmalısınız!", vbCritical
        Exit Sub
    End If
    
    On Error Resume Next
    
    Ek = 1
    
    For X = 1 To Worksheets.Count
        If Worksheets(X).Range("T1").Value <> "" Then
            Sayfa_Adi = Left(Worksheets(X).Range("T1").Value, 31)
            For Y = 0 To UBound(Yasak_Karakterler)
                Sayfa_Adi = Replace(Sayfa_Adi, Yasak_Karakterler(Y), Yeni_Karakter)
            Next
                        
            Worksheets(X).Name = Left(Sayfa_Adi, 31)
            If Err = 1004 Then
                GoTo 10
            Else
                GoTo 20
            End If
10          Ek = Ek + 1
            Sayfa_Adi = Sayfa_Adi & "-" & Ek
            Worksheets(X).Name = Sayfa_Adi
            Ek = 1
            Err.Clear
        End If
20  Next

    MsgBox "Sayfa isimleri değiştirilmiştir.", vbInformation
End Sub

 

[euphrates55]

yeni deneme şansım oldu. teşekkürler.