使用 VBA 插入新 Excel 行太多次导致错误 1004：Range 类的插入方法失败

Question

这段代码运行良好。然后它就停止了工作。如果我删除一行，它会工作一次，然后在那之后再次失败：

当达到“阈值”时，​​代码下面的这一行会出现 1004 错误：

Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

这是 Excel VBA 宏：

 Sub InsertNewRow()
    '
    ' InsertNewRow Macro
    ' Inserts a new row at row 2 and adds the date/time and user name.
    '
    ' Keyboard Shortcut: Ctrl+Shift+N
    '
        ActiveSheet.Rows("2:2").Select
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        ActiveSheet.Range("H2").Select
        ActiveCell.FormulaR1C1 = Now()
        ActiveSheet.Range("J2").Select
        ActiveCell.FormulaR1C1 = UCase(Application.UserName & "")
        ActiveSheet.Range("A2").Select
    End Sub

对为什么会发生这种情况以及如何永久防止这种情况有任何想法吗？

更多信息：

数据在工作表的表格中。如果我只是选择一行然后尝试手动插入一行，则 INSERT 选项将显示为灰色。

如果我选择整个表格行，然后尝试插入表格行，则将行添加到表格的选项也会灰显。这似乎是 Excel 格式表的限制。我不确定为什么它不能处理低于 6000 行。好像有问题。

我试过这个是不是表本身的限制：

...收到此错误：

Answer 1

在这里，试试这个：

Option Explicit 'force variable declaration
Sub InsertNewRow()

    'Lets assume your column with all the rows filled is H so if this is not correct, feel free to make the changes needed.
    'You need to avoid using .Select or .Activate and this is a way to do so:

    'Working with the With block will allow you to reference an object with just a dot. in this case a worksheet
    With ThisWorkbook.Sheets("YourSheet") 'fully quallify your ranges, ThisWorkbook means the workbook with the code and change YourSheet

        'Declare a variable to check the last row with data
        Dim LastRow As Long
        LastRow = .Cells(1, "H").End(xlDown).Row 'this could erase data if you have blank cells between

        'check if the last row with data is the last row for the sheet
        If LastRow = .Rows.Count Then
            MsgBox "Sorry, no more rows can be added to this sheet." 'if so, pop a warning
            Exit Sub
        Else
            .Rows(LastRow + 1 & ":" & .Rows.Count).Delete 'if not, delete all the rows below your last row to avoid problems
        End If

        .Rows(2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        .Range("H2") = Now 'this will print a value, so it won't change every second
        .Range("J2") = UCase(Application.UserName & "")

    End With

        'There was no need to select anything in this code, your sheet could even be hidden and this will work

End Sub

阅读this 了解如何避免使用 select 或 activate 的更多信息。