多表格工作表VBA插入行报错1004的解决方案咨询

宏概述 #

VBA（插入行宏） 功能：弹出对话框询问需插入的行数，遍历工作簿多个工作表插入行（部分工作表需多处插入）；再次遍历相同位置，复制插入前最后一行的公式。工作簿内有一张VBA工作表，通过计算和输入存储最后行号。

工作簿背景 #

「租赁」工作表中存在多张沿列对齐的Excel表格，占据第4-24行（含总计行），包含当前租户、未来假设租赁、租赁审核计算等数据，供工作簿其他计算使用。采用独立表格而非单一大表格，是为了让公式引用更直观，降低用户初始数据录入复杂度。

问题 #

宏运行时触发错误1004：「Range类的Insert方法失败」。逐步调试发现，首次循环在租赁工作表选中第24行时无法完成插入操作，推测因工作表中存在多张对齐表格，Excel不允许在表格结构内（第4-24行）插入行，测试确认仅能在表格结构外插入行。

现有代码 #

Option Explicit
Option Base 1

Sub InsertRow()

'Sub to insert x rows throughout the work book

     
    Dim RowNum As Long
    Dim myLoop As Long
    Dim numberOfCells As Long
    Dim rowToInsert As Integer
    Dim SheetMyVar As String
    
    Dim mySheet As String
        
       
         
       'user input for rows
       
     RowNum = InputBox("Enter number of rows required.")
        If RowNum = 0 Then Exit Sub
        
     
       'turn off screen updates
   Application.ScreenUpdating = False
     
        'go to AuditVB page
    Sheet26.Activate
        
        'get total number of times to run through loop by counting cells in the list of additional row locations
        numberOfCells = Range("D5", Range("D4").End(xlDown)).Count
                
For myLoop = 1 To numberOfCells 'data on AuditVB sheet

            mySheet = Range("D4").Offset(myLoop, 6).Value  'this is sheet name
            
            rowToInsert = Range("D4").Offset(myLoop, 5).Value ' this is the row column
        
        'check if the 'sheet name' column has any data, if it does then check if the 'row number' reference is not equal to 0. If both conditions are met run through the loop
    If mySheet <> "" Then
    If rowToInsert <> 0 Then
                    
        With Sheets(mySheet).Activate 'activate the sheet name as per VBAudit page
            Rows(rowToInsert).Resize(RowNum).Insert 'Goto the row as stated on the VBAudit page
               
        End With
          
            
    Sheet26.Activate 'takes me back to the AuditVB worksheet

            
       End If
        End If
    
    Application.Calculate 'calculate the workbook so that the VBAudit references update and the rows are added in the correct spots.

    
Next myLoop

 
For myLoop = 1 To numberOfCells 'data on AuditVB sheet

            mySheet = Range("D4").Offset(myLoop, 6).Value  'this is sheet name
            
            rowToInsert = Range("D4").Offset(myLoop, 5).Value - RowNum ' this is the row column
        
        'check if the 'sheet name' column has any data, if it does then check if the 'row number' reference is not equal to 0. If both conditions are met run through the loop
    If mySheet <> "" Then
    If rowToInsert <> 0 Then
                    
        With Sheets(mySheet).Activate 'activate the sheet name as per VBAudit page
            Rows(rowToInsert).Offset(-1, 0).Copy _
            Rows(rowToInsert).Resize(RowNum, 1) 'Insert the number of rows stipluated in the original input box and copy down format and formula from the row previous

               
        End With
          
            
    Sheet26.Activate 'takes me back to the AuditVB worksheet

            
       End If
        End If
    
   
    
Next myLoop

  Application.Calculate 'calculate the workbook so that the VBAudit references update and the rows are added in the correct spots.

        Application.ScreenUpdating = True


End Sub

解决方案 #

不需要合并成大表格，以下两种VBA方案更简便：

方案1：利用表格原生插入功能（推荐） #

Excel的ListObject（表格）支持直接在内部插入行，无需破坏原结构。只需定位目标行所属的表格，调用表格的插入方法即可：

修改插入行阶段的核心代码：

' 替换原With Sheets(mySheet).Activate...块
With Sheets(mySheet)
    Dim targetTbl As ListObject
    Set targetTbl = Nothing
    
    ' 遍历工作表内所有表格，判断目标行是否属于某张表格
    For Each targetTbl In .ListObjects
        If rowToInsert >= targetTbl.Range.Row And rowToInsert <= targetTbl.Range.Row + targetTbl.ListRows.Count Then
            Exit For
        End If
    Next targetTbl
    
    If Not targetTbl Is Nothing Then
        ' 在表格内插入指定行数
        Dim insertPos As Integer
        insertPos = rowToInsert - targetTbl.Range.Row + 1
        
        ' 批量插入行（循环添加）
        For i = 1 To RowNum
            targetTbl.ListRows.Add Position:=insertPos, AlwaysInsert:=True
        Next i
    Else
        ' 目标行不在表格内，执行原插入逻辑
        .Rows(rowToInsert).Resize(RowNum).Insert
    End If
End With

此方法保留表格的格式和公式自动填充特性，稳定性更高。

方案2：临时转换表格为普通区域再恢复 #

先将目标区域的表格转为普通单元格区域，完成插入后重新创建表格：

修改插入行阶段的核心代码：

With Sheets(mySheet)
    Dim tbl As ListObject
    Dim tblInfos As Collection
    Set tblInfos = New Collection
    
    ' 提前记录所有表格的位置、名称
    For Each tbl In .ListObjects
        tblInfos.Add Array(tbl.Name, tbl.Range.Address)
        tbl.Unlist ' 转换为普通区域
    Next tbl
    
    ' 执行插入行操作
    .Rows(rowToInsert).Resize(RowNum).Insert
    
    ' 重新创建表格
    Dim info As Variant
    For Each info In tblInfos
        Dim rng As Range
        Set rng = .Range(info(1))
        ' 调整表格范围（因插入了行）
        Set rng = rng.Resize(rng.Rows.Count + RowNum)
        .ListObjects.Add(xlSrcRange, rng, , xlYes).Name = info(0)
    Next info
End With

注意：需确保原表格的格式、公式规则能被正确恢复，适合表格结构固定的场景。

额外优化建议 #

1. 移除Activate/Select操作，直接通过工作表对象操作，提升代码效率：

   ' 替换原Sheet26.Activate操作，直接引用单元格
   mySheet = Sheet26.Range("D4").Offset(myLoop, 6).Value
   

2. 添加错误捕获，避免因特殊情况导致宏中断：

   On Error Resume Next
   ' 插入行操作代码
   If Err.Number <> 0 Then
       MsgBox "在工作表" & mySheet & "的第" & rowToInsert & "行插入失败"
       Err.Clear
   End If
   On Error GoTo 0
   

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