Question

我正在使用-

在表格底部添加一行

Dim Lr As Integer
Application.ScreenUpdating = False
Lr = Range("B" & Rows.Count).End(xlUp).Row 'Searching last row in column B
    Rows(Lr + 1).Insert Shift:=xlDown 'Inserting new row
    Cells(Lr + 1, "B") = Cells(Lr, "B") + 1 'Adding a sequential number
    Rows(Lr).Copy 'Copying format of last row
    Rows(Lr + 1).PasteSpecial Paste:=xlPasteFormats 'Pasting format to new row
    Application.CutCopyMode = False 'Deactivating copy mode

该行中有一些公式需要复制到新行中。与

Rows(Lr + 1).PasteSpecial Paste:xlPasteFormats

它仅粘贴具有序号的新行，而不粘贴公式。并

Rows(Lr + 1).PasteSpecial Paste:xlPasteFormulas

它仅粘贴具有公式但没有序列号的新行。某处缺少东西。请帮助我。

Answer 1

我相信以下内容将达到您的期望，我对您的代码进行了一些调整，声明您正在使用的工作表始终是一个好主意，因此Excel不会假定它是ActiveSheet，另外，我将Integer更改为Long，因为Excel的行数超出了Integer的处理能力，请在下面查看：

Sub foo()
Dim ws As Worksheet: Set ws = ActiveSheet
'declare and set the worksheet you are working with, amend ActiveSheet to "Sheets("YourSheetName")"
Dim Lr As Long
Application.ScreenUpdating = False
Lr = ws.Range("B" & ws.Rows.Count).End(xlUp).Row 'Searching last row in column B
    ws.Rows(Lr + 1).Insert Shift:=xlDown 'Inserting new row
    ws.Rows(Lr).Copy 'Copying format of last row
    ws.Rows(Lr + 1).PasteSpecial Paste:=xlPasteFormats 'Pasting format to new row
    ws.Rows(Lr + 1).PasteSpecial Paste: xlPasteFormulas
    ws.Cells(Lr + 1, "B") = ws.Cells(Lr, "B") + 1 'Adding a sequential number
    Application.CutCopyMode = False 'Deactivating copy mode
Application.ScreenUpdating = True
End Sub

按顺序添加一行

1 个答案: