EXCEL&WPS工作表批量重命名(按照sheet1中A列内容)
将工作表名称批量重命名(按照sheet1中A列内容)
- 打开WPS Office的Excel文件。
- 按 Alt + F11 打开VBA编辑器。
- 在VBA编辑器中,插入一个新模块:点击 插入 -> 模块。
- 将以下代码粘贴到模块中:
- 运行→运行宏
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
原文地址:https://blog.csdn.net/a1b1cc1/article/details/142824138
免责声明:本站文章内容转载自网络资源,如本站内容侵犯了原著者的合法权益,可联系本站删除。更多内容请关注自学内容网(zxcms.com)!