将工作表名称批量重命名（按照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