VBA创建分类工作表代码新增行后触发1004错误求助

问题背景 #

需求为：编写VBA代码创建与指定单元格同名的工作表，并将对应单元格内容复制到该工作表中。原有代码可正常运行，添加Next cell前的Sheets(cell.name).Range("d3").End(xlDown).Offset(1, 0) = cell行后，在For Each cell In Sheets("Data").Range("d4", Range("d" & Rows.Count).End(xlUp))行触发1004运行时错误。

原代码如下：

Sub create_category()

Dim cell As Range
Dim wsname As Worksheet
Dim test As Boolean

For Each cell In Sheets("Data").Range("d4", Range("d" & Rows.Count).End(xlUp))
    test = False

    For Each wsname In ThisWorkbook.Sheets
        If wsname.name = cell Then test = True
    Next wsname
    
    If test = False Then Sheets.Add after:=Sheets(Sheets.Count)
    ActiveSheet.name = cell
        
    Sheets(cell.name).Range("d3").End(xlDown).Offset(1, 0) = cell         
Next cell

Sheets("Data").Select

End Sub

错误原因分析 #

1. 未限定范围的工作表引用：Range("d" & Rows.Count).End(xlUp)没有指定父工作表，当代码执行过程中激活了其他工作表（比如新建的工作表），这部分会引用当前激活表的D列，导致与Sheets("Data").Range("d4")组合的范围无效，触发1004错误。
2. 依赖ActiveSheet的风险：新建工作表后直接用ActiveSheet.name = cell，如果单元格内容包含非法工作表名称字符，会导致ActiveSheet引用错误；后续Sheets(cell.name)也可能因名称创建失败而出错。
3. 目标表写入逻辑缺陷：Range("d3").End(xlDown)如果D3单元格为空，会直接跳到工作表最后一行，Offset(1,0)后超出有效单元格范围，引发写入错误。

修正后的代码 #

Sub create_category()
    Dim cell As Range
    Dim targetWs As Worksheet
    Dim lastRow As Long
    Dim dataWs As Worksheet
    
    ' 明确引用Data工作表，避免激活表切换影响
    Set dataWs = ThisWorkbook.Sheets("Data")
    
    ' 遍历Data表D4到最后非空行的单元格
    For Each cell In dataWs.Range("D4", dataWs.Range("D" & dataWs.Rows.Count).End(xlUp))
        ' 跳过空单元格
        If Trim(cell.Value) = "" Then GoTo NextCell
        
        ' 检查工作表是否存在
        On Error Resume Next
        Set targetWs = ThisWorkbook.Sheets(CStr(cell.Value))
        On Error GoTo 0
        
        ' 如果不存在则新建，同时处理非法名称字符
        If targetWs Is Nothing Then
            Set targetWs = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
            ' 替换工作表名称中不允许的字符
            targetWs.Name = Replace(Replace(Replace(CStr(cell.Value), "/", "-"), "\", "-"), ":", "-")
        End If
        
        ' 找到目标表D列最后非空行，写入数据
        With targetWs
            lastRow = .Range("D" & .Rows.Count).End(xlUp).Row
            ' 如果D3及以上都是空的，从D4开始写入
            If lastRow < 3 Then lastRow = 3
            .Range("D" & lastRow + 1).Value = cell.Value
        End With
        
        ' 重置对象变量
        Set targetWs = Nothing
        
NextCell:
    Next cell
    
    ' 回到Data工作表（可选操作）
    dataWs.Select
End Sub

关键修正点说明 #

• 限定所有范围的父工作表：所有Range和Rows.Count都明确绑定到dataWs或targetWs，彻底避免因激活表切换导致的引用错误。
• 高效检查工作表存在性：用On Error Resume Next替代遍历所有工作表的循环，大幅提升执行效率。
• 处理非法工作表名称：自动替换工作表名称中不允许的字符（/ \ :），避免创建工作表时的报错。
• 优化目标表写入逻辑：先确定D列最后非空行，若D3为空则从D4开始写入，解决End(xlDown)跳转到无效行的问题。
• 避免依赖ActiveSheet：直接使用工作表对象变量操作，提升代码稳定性和可读性。

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