Excel VBA按第2列内容分发行到同名工作表报1004错误如何解决

错误原因排查 #

• 变量拼写错误：声明的变量为dernierelilgne，实际使用的是derniereligne，变量未正确初始化导致循环范围异常
• 数据类型溢出：行号变量使用Integer类型，最大仅支持32767行，行数超过该值就会触发报错
• 索引越界风险：代码固定遍历前9个工作表（j = 1 To 9），如果当前工作簿工作表总数少于9，直接触发1004错误
• 冗余的Select操作：大量依赖Select/Selection操作，工作表激活状态异常时会导致单元格引用错误
• 删除行逻辑异常：未判断当前表最后一行是否大于等于6，会出现无效删除操作

修复后代码 #

Option Explicit ' 强制变量声明，避免拼写错误

Sub ventilation()
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim LastRow As Long
    Dim derniereligne As Long
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    
    Application.ScreenUpdating = False
    ' 绑定source工作表，避免反复切换
    Set wsSource = ThisWorkbook.Worksheets("source")
    
    ' 遍历工作表，先判断工作表总数避免越界
    For j = 1 To Application.Min(9, ThisWorkbook.Worksheets.Count)
        Set wsTarget = ThisWorkbook.Worksheets(j)
        
        ' 清空目标表第6行及以下内容
        LastRow = wsTarget.Range("A" & wsTarget.Rows.Count).End(xlUp).Row
        If LastRow >= 6 Then
            wsTarget.Rows("6:" & LastRow).Delete Shift:=xlUp
        End If
        
        ' 获取source表最大行
        derniereligne = wsSource.Range("A" & wsSource.Rows.Count).End(xlUp).Row
        
        ' 遍历source表匹配内容
        For k = 6 To derniereligne
            If wsTarget.Name = CStr(wsSource.Cells(k, 2).Value) Then
                ' 直接复制无需选中
                LastRow = wsTarget.Range("A" & wsTarget.Rows.Count).End(xlUp).Row + 1
                wsSource.Rows(k).Copy Destination:=wsTarget.Cells(LastRow, 1)
            End If
        Next k
    Next j
    
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    MsgBox "数据拆分完成"
End Sub

额外注意事项 #

• 如果你的目标工作表不一定是前9个，可以修改遍历逻辑为匹配工作表名，避免索引对应错误
• 如果source表B列存在空值或者不存在对应工作表的内容，代码会自动跳过不会报错
• 代码默认保留每个目标表前5行的表头内容，和原逻辑一致

内容的提问来源于stack exchange，提问作者Cédric Coutant