Excel VBA插入/删除行时随机触发Error 1004问题求助

Hey there, let's tackle this Error 1004 issue you're facing. The root cause is exactly what you suspected: filtered or hidden rows/columns turn the ranges your macros are working with into non-contiguous (multiple) selections, which Excel blocks for operations like EntireRow.Copy or EntireRow.Delete. Below are targeted fixes for both your modules:

Fix for the InsertRows Module #

The error hits when .EntireRow.Copy tries to target a non-contiguous range (thanks to hidden columns from filtering). We’ll temporarily disable filters, run the insert/copy, then restore the original filter state to avoid disrupting the user’s view.

Here’s the revised code:

Sub InsertRows(ByVal splitVal As Integer, ByVal keyCells As Range, ws As Worksheet)
    On Error GoTo ErrorHandler
    Dim filterState As Boolean
    Dim filterCols As Variant
    Dim i As Integer
    
    PW
    ws.Unprotect Password
    ws.DisplayPageBreaks = False
    WBFast
    
    ' Save current filter state and criteria
    filterState = ws.AutoFilterMode
    If filterState Then
        ReDim filterCols(1 To ws.AutoFilter.Filters.Count)
        For i = 1 To ws.AutoFilter.Filters.Count
            Set filterCols(i) = ws.AutoFilter.Filters(i)
        Next i
        ' Turn off filters temporarily
        ws.AutoFilterMode = False
    End If
    
    With keyCells
        .Offset(1).Resize(splitVal).EntireRow.Insert
        .EntireRow.Copy .Offset(1, 0).Resize(splitVal).EntireRow ' Now works on a contiguous range
        Application.CutCopyMode = False ' Clean up clipboard
    End With
    
    ' Restore original filters
    If filterState Then
        ws.Range(ws.AutoFilter.Range.Address).AutoFilter
        ' Reapply saved filter criteria
        For i = 1 To UBound(filterCols)
            If filterCols(i).On Then
                ws.AutoFilter.Range.AutoFilter Field:=i, Criteria1:=filterCols(i).Criteria1, _
                    Operator:=filterCols(i).Operator, Criteria2:=filterCols(i).Criteria2
            End If
        Next i
    End If
    
ExitHandler:
    ws.Protect Password:=Password, DrawingObjects:=True, Contents:=True, Scenarios:=False _
        , AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True, AllowFormattingRows:=True, AllowFormattingColumns:=True, AllowFormattingCells:=True
    WBNorm ' Reset workbook to normal mode
    Exit Sub
ErrorHandler:
    WBNorm
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Insert_Rows, line " & Erl & "."
    GoTo ExitHandler
End Sub

Key changes:

• Saves and restores filter state so users don’t lose their view
• Ensures the copy/insert runs on a contiguous range (no hidden columns interfering)
• Clears the clipboard to avoid lingering copy data

Fix for the DeleteTableRows Module #

The issue here is using EntireRow.Delete on non-contiguous ranges from filtered table rows. Instead, we’ll work directly with Excel’s table (ListObject) native ListRows object—this handles filtered rows seamlessly without triggering the multiple selection error.

Here’s the revised code:

Sub DeleteTableRows()
    'PURPOSE: Delete table row based on user's selection
    Call PW
    Dim rng As Range
    Dim DeleteRows As Collection
    Dim cell As Range
    Dim area As Range
    Dim ReProtect As Boolean
    Dim wb As Workbook
    Dim tbl As ListObject
    Dim Answer As Variant
    
    Set DeleteRows = New Collection
    WBFast
    
    'Set Range Variable
    On Error GoTo InvalidSelection
    Set rng = Selection
    On Error GoTo 0
    
    'Unprotect Worksheet
    Set wb = ThisWorkbook
    With wb.ActiveSheet
        If .ProtectContents Or .ProtectDrawingObjects Or .ProtectScenarios Then
            On Error GoTo InvalidPassword
            .Unprotect Password
            ReProtect = True
            On Error GoTo 0
        End If
        ' Get the table from the first selected cell
        On Error GoTo InvalidSelection
        Set tbl = rng.Cells(1).ListObject
        On Error GoTo 0
    End With
    
    'Collect unique ListRows to delete
    On Error Resume Next
    For Each area In rng.Areas
        For Each cell In area.Columns(1).Cells
            Dim lr As ListRow
            Set lr = tbl.ListRows(cell.Row - tbl.HeaderRowRange.Row)
            If Not lr Is Nothing Then
                ' Add to collection to avoid duplicate selections
                DeleteRows.Add lr, Key:=CStr(lr.Index)
            End If
        Next cell
    Next area
    On Error GoTo 0
    
    'Error Handling
    If DeleteRows.Count = 0 Then GoTo InvalidSelection
    If DeleteRows.Count = tbl.ListRows.Count Then GoTo DeleteAllRows
    If tbl.ListRows.Count = 1 Then GoTo DeleteOnlyRow
    
    'Confirm deletion with user
    Answer = MsgBox("Are you sure you want to delete " & DeleteRows.Count & " table row(s)? This cannot be undone...", vbYesNo, "Delete Rows?")
    
    'Delete rows from bottom to top to avoid index shifting
    If Answer = vbYes Then
        Dim i As Integer
        For i = DeleteRows.Count To 1 Step -1
            DeleteRows(i).Delete
        Next i
        WBNorm
    End If
    
    'Protect Worksheet
ProtectExit:
    If ReProtect = True Then
        wb.Worksheets("Open Orders").Protect Password:=Password, DrawingObjects:=True, Contents:=True, Scenarios:=False _
            , AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True, AllowFormattingRows:=True, AllowFormattingColumns:=True, AllowFormattingCells:=True
    End If
    WBNorm
    Exit Sub
    
'ERROR HANDLERS
InvalidSelection:
    MsgBox "You must select a cell within an Excel table", vbCritical, "Invalid Selection!"
    GoTo ProtectExit
    
InvalidPassword:
    MsgBox "Incorrect password to unprotect the worksheet", vbCritical, "Password Error!"
    GoTo ProtectExit
    
DeleteAllRows:
    Answer = MsgBox("Are you sure you want to delete ALL table rows? This cannot be undone...", vbYesNo, "Delete All Rows?")
    If Answer = vbYes Then
        tbl.DataBodyRange.Delete
    End If
    GoTo ProtectExit
    
DeleteOnlyRow:
    Answer = MsgBox("Are you sure you want to delete the only table row? This cannot be undone...", vbYesNo, "Delete Only Row?")
    If Answer = vbYes Then
        tbl.ListRows(1).Delete
    End If
    GoTo ProtectExit
End Sub

Key changes:

• Uses a Collection to gather unique ListRow objects (avoids duplicate deletions)
• Deletes rows via ListRow.Delete instead of EntireRow.Delete—native table method handles filtered rows flawlessly
• Deletes from bottom to top to prevent index shifting issues
• Streamlined error handling and table detection

Why This Works #

• For the insert macro: Temporarily removing filters ensures the copy/insert runs on a contiguous range, eliminating the "multiple selection" error. We restore filters afterward to preserve the user’s workflow.
• For the delete macro: Working directly with ListRows leverages Excel’s built-in table functionality, which natively understands filtered rows and avoids non-contiguous range errors.

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