欢迎您访问 最编程 本站为您分享编程语言代码,编程技术文章!
您现在的位置是: 首页

EXCEL&WPS 工作表批量重命名(根据工作表 1 中 A 列的内容)

最编程 2024-10-11 14:46:33
...
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

推荐阅读