Long time lurker, first time posting...

I have a small bit of code that I would like to loop through worksheets 6 to the last worksheet from a range of cells in worksheet called Index in cells D5:D20. In cells C5:C20 are the names of the worksheets I would like to use, and in column D, these names are formatted to begin with a number (1., 2., 3. and so on).

Worksheet 6 renames fine. However, when it moves onto worksheet 7, I keep getting an error "Run-time error '9': Subscript out of range"

This is the code I have written so far:

Sub RenameSheets()

Dim i As Integer
Dim j As Integer
Dim a As Integer

a = ThisWorkbook.Worksheets.Count

For i = 6 To a
 For j = 5 To 20
    
    If Worksheets(i).Name = Worksheets("Index").Cells(j, 3).Value Then
    Worksheets(i).Name = Worksheets("Index").Cells(j, 4).Value
    End If
    
 Next
Next

End Sub

What I would like it to do is Worksheets(6).Name = Worksheets("Index").Cells(5, 4).Value. then move to Worksheets(7).Name = Worksheets("Index").Cells(6, 4).Value

Any help would be greatly appreciated!!

CodePudding user response：

Take a look at this example to help with your issue:

Dim i as long
For i = 5 to Sheets.Count-1 Step 1
    Dim varName as string
    varName = sheets("index").cells(i,4).value
    If IsError(Evaluate("'" & varName & "'" & "!A1")) Then 
        Sheets(i 1).name = varName
    Else
        MsgBox("Sheet name already exists")
    End if
next i

Note that I used i 1 in the Else section, so I could start at Sheets(6).

Using IfError() when evaluating is cells A1 exists on a sheet named with the varName, you can determine if the sheet exists already; as such, this should prevent the error you're receiving.

Edit1: added "'" in the evaluate to account for spaces in the varName (Thanks Ben!)

CodePudding user response：

Rename Worksheets Using a List

• There are a few 'surprises lurking'. Some are covered deeper than others.
• The approach is quite different: it tries to rename whatever is in column C to whatever is in column D also monitoring the worksheet index.

Sub RenameWorksheets()

    ' Define constants.
    ' It is assumed that the index of the source worksheet
    ' is less than 'dMinIndex' to keep it safe!
    
    ' Source (containing the list)
    Const sName As String = "Index"
    Const srCol As String = "C" ' old, read
    Const swCol As String = "D" ' new, write (rename)
    Const sfRow As Long = 5
    ' Destination (being renamed)
    Const dMinIndex As Long = 6

    ' Reference the workbook ('wb').
    Dim wb As Workbook: Set wb = ThisWorkbook

    ' Reference the source worksheet ('sws').
    Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
    
    ' Reference the read and write ranges ('srrg', 'swrg').
    
    Dim slRow As Long: slRow = sws.Cells(sws.Rows.Count, srCol).End(xlUp).Row
    
    If slRow < sfRow Then
        MsgBox "No data in column range.", vbCritical
        Exit Sub
    End If
    
    Dim srrg As Range
    Set srrg = sws.Range(sws.Cells(sfRow, srCol), sws.Cells(slRow, srCol))
    Dim swrg As Range: Set swrg = srrg.EntireRow.Columns(swCol)
    
    ' Rename the destination worksheets ('dws') whose names are in the list
    ' and whose index is greater than or equal to 'dMinIndex'.
    
    Dim dws As Worksheet
    Dim srCell As Range
    Dim sString As String
    Dim r As Long
    Dim ErrNum As Long
    Dim wsCount As Long
    
    For Each srCell In srrg.Cells
        r = r   1 ' to reference the cell in the same row in the write column
        sString = CStr(srCell.Value)
        If Len(sString) > 0 Then ' the source read cell is not blank
            ' Attempt to reference the destination worksheet.
            On Error Resume Next
                Set dws = wb.Worksheets(sString)
            On Error Goto 0
            If Not dws Is Nothing Then ' the destination worksheet exists
                If dws.Index >= dMinIndex Then ' the worksheet index is ok
                    ' Attempt to rename the destination worksheet.
                    On Error Resume Next
                        dws.Name = CStr(swrg.Cells(r).Value)
                        ErrNum = Err.Number
                    On Error GoTo 0
                    If ErrNum = 0 Then ' successfully renamed
                        wsCount = wsCount   1
                    'Else ' not renamed (not interested in the why); do nothing
                    End If
                'Else ' the worksheet index is too small; do nothing
                End If
                Set dws = Nothing ' reset the destination worksheet variable
            'Else ' the destination worksheet doesn't exist; do nothing
            End If
        'Else ' the source read cell is blank; do nothing
        End If
    Next srCell
        
    ' Save the workbook.
    'wb.Save
    
    ' Inform.
    MsgBox "Renamed " & wsCount & " worksheet" & IIf(wsCount = 1, "", "s") _
        & ".", vbInformation

End Sub