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

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

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

1. Sub RenameSheetsBasedOnSheet1()  
2.     Dim ws As Worksheet  
3.     Dim sheet1 As Worksheet  
4.     Dim i As Long, lastRow As Long  
5.     Dim newName As String  
6.     Dim nameExists As Boolean  
7.       
8.     ' Set the sheet1 worksheet (assuming it's named "Sheet1")  
9.     Set sheet1 = ThisWorkbook.Sheets("Sheet1")  
10.       
11.     ' Find the last row with data in column A of Sheet1  
12.     lastRow = sheet1.Cells(sheet1.Rows.Count, 1).End(xlUp).Row  
13.       
14.     ' Loop through all sheets except Sheet1  
15.     For Each ws In ThisWorkbook.Sheets  
16.         If ws.Name <> sheet1.Name Then  
17.             ' Get the new name from Sheet1's A column  
18.             i = i + 1  
19.             If i <= lastRow Then  
20.                 newName = sheet1.Cells(i, 1).Value  
21.                   
22.                 ' Check if the new name is valid and not already used  
23.                 nameExists = False  
24.                 For Each wks In ThisWorkbook.Sheets  
25.                     If wks.Name = newName And wks.Name <> ws.Name Then  
26.                         nameExists = True  
27.                         Exit For  
28.                     End If  
29.                 Next wks  
30.                   
31.                 If newName <> "" And Not nameExists Then  
32.                     ' Rename the sheet  
33.                     On Error Resume Next ' In case of any error (e.g., invalid sheet name)  
34.                     ws.Name = newName  
35.                     If Err.Number <> 0 Then  
36.                         MsgBox "Error renaming sheet to " & newName & ": " & Err.Description, vbCritical  
37.                         Err.Clear  
38.                     End If  
39.                     On Error GoTo 0 ' Reset error handling  
40.                 Else  
41.                     If newName = "" Then  
42.                         MsgBox "Empty name found in Sheet1 A" & i & ". Skipping this rename.", vbExclamation  
43.                     Else  
44.                         MsgBox "Name """ & newName & """ already exists. Skipping this rename.", vbExclamation  
45.                     End If  
46.                 End If  
47.             Else  
48.                 Exit For ' No more names to assign  
49.             End If  
50.         End If  
51.     Next ws  
52.       
53.     MsgBox "Sheets have been renamed based on Sheet1 A column where possible.", vbInformation  
54. End Sub

复制代码