Excel VBA代码运行时出现40036错误，求修复方案

错误原因分析 #

40036错误通常和工作表名称验证逻辑漏洞或事件触发时的异常输入有关，结合你的代码场景，主要是输入处理不严谨、遍历范围不当等问题导致。

具体修复步骤 #

• 限制Target为单个单元格：Worksheet_Change事件触发时，若用户选中多个单元格修改，Target.Value会返回数组而非单个值，直接调用LCase(Target.Value)会报错。在代码开头添加判断：

  If Target.Cells.Count > 1 Then Exit Sub
  

• 替换Sheets为Worksheets遍历：ActiveWorkbook.Sheets包含工作表、图表、宏表等所有Sheet类型对象，部分非工作表对象的Name属性访问可能触发异常。改为仅遍历普通工作表：

  For Each ws In ActiveWorkbook.Worksheets
  

• 验证输入名称的合法性：Excel工作表名称有严格限制（不能包含\ / ? * [ ]字符，长度≤31，不能为空或仅空格），非法名称会导致后续操作报错。添加验证逻辑：

  Dim invalidChars As String
  invalidChars = "\/?*[]"
  If Len(Trim(Target.Value)) = 0 Then
      MsgBox "工作表名称不能为空！"
      GoTo ende
  End If
  If Len(Target.Value) > 31 Then
      MsgBox "工作表名称不能超过31个字符！"
      GoTo ende
  End If
  For i = 1 To Len(Target.Value)
      If InStr(1, invalidChars, Mid(Target.Value, i, 1)) > 0 Then
          MsgBox "工作表名称包含非法字符：\ / ? * [ ]"
          GoTo ende
      End If
  Next i
  

• 禁用事件防止递归触发：复制模板并重命名时，可能意外触发其他Worksheet_Change事件（比如模板中有联动公式），添加事件禁用避免冲突：

  Application.EnableEvents = False ' 在ScreenUpdating之后添加
  ' ... 核心代码逻辑 ...
  Application.EnableEvents = True ' 在ScreenUpdating恢复之前添加
  

修改后的完整代码 #

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim ws As Worksheet
    Dim invalidChars As String
    Dim i As Integer
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    ' 处理多单元格选择或空值
    If Target.Cells.Count > 1 Or Len(Trim(Target.Value)) = 0 Then
        GoTo ende
    End If
    
    If Target.Row >= 8 And Target.Column = 1 Then
        ' 验证名称合法性
        invalidChars = "\/?*[]"
        If Len(Target.Value) > 31 Then
            MsgBox "工作表名称不能超过31个字符！"
            GoTo ende
        End If
        For i = 1 To Len(Target.Value)
            If InStr(1, invalidChars, Mid(Target.Value, i, 1)) > 0 Then
                MsgBox "工作表名称包含非法字符：\ / ? * [ ]"
                GoTo ende
            End If
        Next i
        
        If MsgBox("Tabelenblatt mit Name """ & Target.Value & """ anlegen ?", _
            vbYesNo, "Blatt Vorlage kopieren") = vbYes Then
            
            ' 检查同名工作表是否存在
            For Each ws In ActiveWorkbook.Worksheets
                If LCase(ws.Name) = LCase(Target.Value) Then
                    MsgBox "Blatt mit dem eingegeben Namen existiert bereits!"
                    GoTo ende
                End If
            Next ws
            
            ' 复制模板并重命名
            Worksheets("Vorlage").Copy before:=Worksheets("Vorlage")
            ActiveSheet.Name = Target.Value
        End If
    End If

ende:
    Set ws = Nothing
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

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