为单个Excel工作表添加代码的宏：单元格变更高亮实现问题

关键问题分析 #

你之前的问题出在两个核心点：

• 未正确获取新工作簿里的目标工作表对象wsNew，直接用未赋值的wsNew作为VBComponent索引，必然触发类型不匹配错误
• Worksheet_Change是工作表级事件，必须放在对应工作表的代码模块里才会生效，你之前加到ThisWorkbook（工作簿级模块）自然无法触发单元格变更的高亮逻辑

修正后的完整代码 #

Sub CopyTablesToNewFiles_DeleteConnections_Worksheet_Change2()
    Dim wbSource As Workbook, wbNew As Workbook
    Dim ws As Worksheet, wsNew As Worksheet
    Dim savePath As String, currentDate As String, fileName As String

    currentDate = Format(Date, "YYYYMMDD")
    Set wbSource = ThisWorkbook
    savePath = "C:\path\Test\" '提前定义路径，避免循环内重复赋值

    For Each ws In wbSource.Worksheets
        ws.Copy
        Set wbNew = ActiveWorkbook
        '获取新工作簿中唯一的工作表（即刚复制出来的目标表）
        Set wsNew = wbNew.Worksheets(1)

        '向目标工作表的代码模块插入Worksheet_Change事件代码
        With wbNew.VBProject.VBComponents(wsNew.CodeName).CodeModule
            '在模块末尾插入代码（新工作表模块默认为空，无需担心覆盖）
            .InsertLines .CountOfLines + 1, _
                "Private Sub Worksheet_Change(ByVal Target As Range)" & vbCrLf & _
                "    '仅对已使用区域的变更着色，避免空白区误触发" & vbCrLf & _
                "    If Not Intersect(Target, Me.UsedRange) Is Nothing Then" & vbCrLf & _
                "        Target.Interior.ColorIndex = 27" & vbCrLf & _
                "    End If" & vbCrLf & _
                "End Sub"
        End With
        
        wbNew.SaveAs Filename:=savePath & currentDate & "_" & ws.Name & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
        wbNew.Close SaveChanges:=False
    Next ws

    'wbSource.Close
End Sub

必做前置设置 #

运行代码前必须开启VBA项目信任访问：
打开Excel选项 → 信任中心 → 信任中心设置 → 宏设置 → 勾选「信任对VBA项目对象模型的访问」，否则会触发「权限被拒绝」错误

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