Sub renameWorksheet()
    
    Dim ws As Worksheet
    
    For Each ws In ThisWorkbook.Worksheets
    
        On Error Resume Next
        ws.Name = Range("O11").Value & "-" & Range("N11").Value
        
    Next ws
    
End Sub

Because when I rename worksheets and there are two or more worksheets names duplicate, get this error:

That sheet name is already taken. Try another one

Therefore I want if the worksheet name is same with other existing worksheet, then rename the worksheet with "_2". How can I modify the detect part?

CodePudding user response：

What if there's a sheet with a name already with "_2"? You may need to apply more thinking if that's the case.

Try this. I've tested it in my own space but you may need to change the code slightly to get it to work for your exact scenario ...

Sub renameWorksheet()
    
    Dim ws As Worksheet, lngSuffix As Long, strSuffix As String
    
    For Each ws In ThisWorkbook.Worksheets
    
        On Error Resume Next
        
        Err.Description = " "
        lngSuffix = 1
        
        While Err.Description <> ""
            Err.Clear
                    
            ws.Name = Range("O11").Value & "-" & Range("N11").Value
            
            If Err.Description <> "" Then
                strSuffix = "_" & lngSuffix
                lngSuffix = lngSuffix   1
            End If
        Wend
    Next ws
    
End Sub

CodePudding user response：

Rename Worksheets With Increment

1. Loops through all worksheets in a workbook.
2. From cells of each worksheet, it builds a string to be used as the worksheet's new name (NewName).
3. If the new name is equal (vbTextCompare) to the worksheet name, then if DoCorrectCase is set to True, it renames correcting the case (vbBinaryCompare). Finally, it exits.
4. If the string is not equal it tries to find a worksheet with the same name.
5. If not found, it renames the worksheet and exits.
6. If found, it adds an increment to the new name and continues with step 3, until it exits in step 3 or 5.

Option Explicit

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      In the workbook containing this code, by concatenating values
'               from two cells in each worksheet, uses the concatenated
'               string to rename them.
'               Adds an increment if a sheet with the same name already exists.
' Calls:        'RenameWorksheetWithIncrement'.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub RenameWorksheets()
    
    Const LeftDelimiter As String = "_"
    Const FirstNewIndex As Long = 2
    Const RightDelimiter As String = ""
    Const DoCorrectCase As Boolean = False
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim sws As Worksheet
    Dim NewName As String
    
    For Each sws In wb.Worksheets

        NewName = CStr(sws.Range("O11").Value) _
            & "-" & CStr(sws.Range("N11").Value)

        RenameWorksheetWithIncrement sws, NewName, _
            LeftDelimiter, FirstNewIndex, RightDelimiter, DoCorrectCase

    Next sws
    
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Renames a worksheet. Adds an increment if a sheet
'               with the same name already exists.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub RenameWorksheetWithIncrement( _
        ByRef sws As Worksheet, _
        ByVal NewName As String, _
        ByVal LeftDelimiter As String, _
        ByVal FirstNewIndex As Long, _
        ByVal RightDelimiter As String, _
        Optional ByVal DoCorrectCase As Boolean = False)
    Const ProcName As String = "RenameWorksheetWithIncrement"
    On Error GoTo ClearError

    Dim wb As Workbook: Set wb = sws.Parent
    Dim nName As String: nName = NewName
    Dim nIndex As Long: nIndex = FirstNewIndex
    Dim swsName As String: swsName = sws.Name

    Dim nws As Worksheet

    Do
        ' Test if already renamed.
        If StrComp(swsName, nName, vbTextCompare) = 0 Then ' ignore case
            If DoCorrectCase Then
                If StrComp(swsName, nName, vbBinaryCompare) <> 0 Then
                    sws.Name = nName ' correct case
                End If
            End If
            Exit Do
        End If

        ' Attempt to create a reference.
        On Error Resume Next ' defer error handling
            Set nws = wb.Worksheets(nName)
        On Error GoTo ClearError ' enable error handling
        'On Error GoTo 0 ' disable error handling (usually, not to be used here)
        
        ' Rename.
        If nws Is Nothing Then
            sws.Name = nName
            Exit Do
        Else
            Set nws = Nothing
            nName = NewName & LeftDelimiter & nIndex & RightDelimiter
            nIndex = nIndex   1
        End If
    Loop

ProcExit:
    Exit Sub
ClearError:
    Debug.Print "'" & ProcName & "': Unexpected Error!" & vbLf _
              & "    " & "Run-time error '" & Err.Number & "':" & vbLf _
              & "    " & Err.Description
    Resume ProcExit
End Sub