Question

I have VBA code to add new rows to a table (data starts in row 5).

I made a new sheet and it works pretty well when the table doesn't have headers. When I add headers, however, the following error pops up

run-time error '1004' this won't work because it would move cells in a table on your worksheet.

I click debug and it highlights Rng.Insert Shift:=x1Down

What is the reason for the error and how can it be corrected?

Sub AddRows()

    Const BaseRow As Long = 5   ' modify to suit

    Dim x As String             ' InputBox returns text if 'Type' isn't specified
    Dim Rng As Range
    Dim R As Long

    x = InputBox("How many rows would you like to add?", "Insert Rows")
    If x = "" Then Exit Sub
    R = BaseRow + CInt(x) - 1

    Rows(BaseRow).Copy          'Copy BaseRow
    'specify range to insert new cells
    Set Rng = Range(Cells(BaseRow, 1), Cells(R, 1))
    Rng.Insert Shift:=xlDown

    ' insert the new rows BEFORE BaseRow
    ' to insert below BaseRow use Rng.Offset(BaseRow - R)
    Set Rng = Rng.Offset(BaseRow - R - 1).Resize(Rng.Rows.Count, ActiveSheet.UsedRange.Columns.Count)
    Rng.Select
    On Error Resume Next
    Rng.SpecialCells(xlCellTypeConstants).ClearContents
    Application.CutCopyMode = False '
End Sub

Answer 1

我认为您的表是一个列表对象。然后以下代码可能会起作用

Sub TestAdd()
Dim myTbl As ListObject
Dim x As String
Dim i As Long

    Set myTbl = Sheet1.ListObjects(1)
    x = InputBox("How many rows would you like to add?", "Insert Rows")

    If x = "" Then Exit Sub
    For i = 1 To CInt(x)
        myTbl.ListRows.Add (1)
    Next i
End Sub

更新：要保留格式和公式，可以使用以下代码

Sub TestAdd()

Dim myTbl As ListObject
Dim x As String
Dim i As Long
Dim newRow As Range
Dim sngCell As Range

    Set myTbl = Sheets("Rentals").ListObjects(1)
    x = InputBox("How many rows would you like to add?", "Insert Rows")
    If x = "" Then Exit Sub
    For i = 1 To CInt(x)
        Set newRow = myTbl.ListRows.Add(1).Range
        With newRow
            .Offset(1).Copy
            ' .PasteSpecial xlPasteFormulasAndNumberFormats
            .PasteSpecial xlPasteFormulas
            .PasteSpecial xlPasteFormats
            For Each sngCell In newRow
                If Not (sngCell.HasFormula) Then
                    sngCell.ClearContents
                End If
            Next
        End With
        Application.CutCopyMode = False
    Next i
End Sub

VBA to insert new row from table with formula

1 个答案: