Excel VBA根据同行指定单元格值批量重命名新建工作表问题

原有代码问题 #

• 重命名逻辑错误：直接对A48:A85整个区域取值，返回的是多单元格数组，无法直接赋值为工作表名称，需要取和当前判断的I列单元格同一行的A列值
• 新表定位逻辑失效：硬编码抓取AP (2)工作表，多次复制后新表默认名会变为AP (3)、AP (4)，无法匹配
• 冗余的Select操作、不必要的数组声明，既降低运行效率也容易触发意外错误

修正后代码 #

Sub CreateAPSheets()
    Dim cell As Range
    Dim newWs As Worksheet
    ' 遍历Setup表I48:I85区域
    For Each cell In ThisWorkbook.Sheets("Setup").Range("I48:I85")
        If cell.Value = "AP" Then
            ' 复制AP模板表到最前面
            ThisWorkbook.Sheets("AP").Copy Before:=ThisWorkbook.Sheets(1)
            ' 直接获取刚复制的新表
            Set newWs = ThisWorkbook.ActiveSheet
            ' 重命名为当前行A列的值
            newWs.Name = ThisWorkbook.Sheets("Setup").Cells(cell.Row, "A").Value
        End If
    Next cell
End Sub

补充说明 #

如果A列存在重复值，会触发工作表重名报错，可根据需要添加错误处理逻辑跳过重复项。

内容的提问来源于stack exchange，提问作者GabrielWad