EXCEL&WPS工作表批量重命名（按照sheet1中A列内容）

将工作表名称批量重命名（按照sheet1中A列内容）

1. 打开WPS Office的Excel文件。
2. 按 Alt + F11 打开VBA编辑器。
3. 在VBA编辑器中，插入一个新模块：点击 插入 -> 模块。
4. 将以下代码粘贴到模块中：
5. 运行→运行宏

Sub RenameSheetsBasedOnSheet1()  
    Dim ws As Worksheet  
    Dim sheet1 As Worksheet  
    Dim i As Long, lastRow As Long  
    Dim newName As String  
    Dim nameExists As Boolean  
      
    ' Set the sheet1 worksheet (assuming it's named "Sheet1")  
    Set sheet1 = ThisWorkbook.Sheets("Sheet1")  
      
    ' Find the last row with data in column A of Sheet1  
    lastRow = sheet1.Cells(sheet1.Rows.Count, 1).End(xlUp).Row  
      
    ' Loop through all sheets except Sheet1  
    For Each ws In ThisWorkbook.Sheets  
        If ws.Name <> sheet1.Name Then  
            ' Get the new name from Sheet1's A column  
            i = i + 1  
            If i <= lastRow Then  
                newName = sheet1.Cells(i, 1).Value  
                  
                ' Check if the new name is valid and not already used  
                nameExists = False  
                For Each wks In ThisWorkbook.Sheets  
                    If wks.Name = newName And wks.Name <> ws.Name Then  
                        nameExists = True  
                        Exit For  
                    End If  
                Next wks  
                  
                If newName <> "" And Not nameExists Then  
                    ' Rename the sheet  
                    On Error Resume Next ' In case of any error (e.g., invalid sheet name)  
                    ws.Name = newName  
                    If Err.Number <> 0 Then  
                        MsgBox "Error renaming sheet to " & newName & ": " & Err.Description, vbCritical  
                        Err.Clear  
                    End If  
                    On Error GoTo 0 ' Reset error handling  
                Else  
                    If newName = "" Then  
                        MsgBox "Empty name found in Sheet1 A" & i & ". Skipping this rename.", vbExclamation  
                    Else  
                        MsgBox "Name """ & newName & """ already exists. Skipping this rename.", vbExclamation  
                    End If  
                End If  
            Else  
                Exit For ' No more names to assign  
            End If  
        End If  
    Next ws  
      
    MsgBox "Sheets have been renamed based on Sheet1 A column where possible.", vbInformation  
End Sub