重命名工作表

短

Sub RenameWorksheetsShort()

    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim ws As Worksheet, NewName As String
    
    For Each ws In wb.Worksheets
        NewName = CStr(ws.Range("B3").Value)
        If ws.Name <> NewName Then
            On Error Resume Next
                ws.Name = NewName
            On Error GoTo 0
        End If
    Next ws

End Sub

字符串

之前

的数据

之后

的

详情

Sub RenameWorksheets()

    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim wsCount As Long: wsCount = wb.Worksheets.Count
    Dim Arr(): ReDim Arr(1 To wsCount)

    Dim ws As Worksheet, w As Long, ErrNumber As Long, NewName As String
    
    For Each ws In wb.Worksheets
        NewName = CStr(ws.Range("B3").Value)
        If ws.Name <> NewName Then
            On Error Resume Next
                ws.Name = NewName
                ErrNumber = Err.Number
            On Error GoTo 0
            If ErrNumber <> 0 Then
                w = w + 1
                Arr(w) = """" & ws.Name & """ to """ & NewName & """"
            End If
        End If
    Next ws

    If w = 0 Then
        MsgBox "Worksheet names updated.", vbInformation
    Else
        If w < wsCount Then
            ReDim Preserve Arr(1 To w)
        End If
        MsgBox "Could not rename the following worksheets:" & vbLf & vbLf _
           & Join(Arr, vbLf), vbCritical
    End If
    
End Sub

型