VBA批量创建Excel工作表时触发运行时错误'1004'求助

错误根因 #

• 变量名拼写错误：已声明变量为count_row，但赋值行误写为count_row_，多了下划线，导致count_row始终为初始值0，构造Range时行号非法
• 未定义变量调用：粘贴目标写为Sheets(reg)，但代码中从未定义reg变量，此处应为部门变量dep
• 关键字拼写错误：错误跳转语句误写为On Eroor，正确写法为On Error
• 单元格对象未绑定父表：Cells(10, 1)默认指向当前活动页单元格，若活动页不是Sheet1时，和Sheet1.Range组合会生成非法跨表范围
• 配置未还原：两次设置Application.DisplayAlerts = False，未恢复为True会导致后续Excel操作屏蔽系统提示
• 无边界判断：筛选后如果没有可见单元格，直接调用SpecialCells(xlCellTypeVisible)会直接触发1004错误

修复后代码 #

Option Explicit ' 强制变量声明，提前捕获拼写类错误
Sub copy_data_2_new_sheets()
    Dim count_col As Integer
    Dim count_row As Integer
    Dim dep As String
    Dim check As Integer
    Dim visibleRng As Range
    
    check = 0
    dep = Sheet1.Cells(2, 6).Text
    
    ' 新建命名工作表，已存在则跳过创建
    On Error GoTo oops
    Sheets.Add(AFTER:=Sheets(Sheets.Count)).Name = dep
    check = 1
oops:
    If check = 0 Then
        Application.DisplayAlerts = False
        ActiveSheet.Delete
        Application.DisplayAlerts = True ' 恢复系统提示
    End If
    
    ' 清空目标表内容
    Sheets(dep).Cells.ClearContents
    
    ' 计算主表有效行列范围
    Sheet1.Activate
    count_col = Sheet1.Range("A10").End(xlToRight).Column
    count_row = Sheet1.Range("A10").End(xlDown).Row
    
    ' 按部门筛选
    Sheet1.Range("A10").AutoFilter Field:=2, Criteria1:=dep
    
    ' 先判断是否有可见单元格再执行复制
    On Error Resume Next
    Set visibleRng = Sheet1.Range(Sheet1.Cells(10, 1), Sheet1.Cells(count_row, count_col)).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    If Not visibleRng Is Nothing Then
        visibleRng.Copy
        Sheets(dep).Cells(1, 1).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
    End If
    
    ' 清除主表筛选
    Sheet1.ShowAllData
    Sheet1.AutoFilterMode = False
End Sub

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