在最后使用的行之后插入新行并从上面复制公式和格式

Question

我想要一个能找到最后一行数据的宏，然后在下面插入一个新行并从上面复制格式和公式（公式在 F 列中）。我的代码每次都会在同一个位置插入一个新行。这可能吗？

这是我所拥有的：

    Sub AddNewRow()
'
' AddNewRow Macro
'

'
    Rows("37:37").Select
    ActiveSheet.Unprotect
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("F36").Select
    Selection.AutoFill Destination:=Range("F36:F37"), Type:=xlFillDefault
    Range("F36:F37").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingCells:=True, AllowDeletingRows:=True, AllowSorting:=True _
        , AllowFiltering:=True
End Sub

Answer 1

您只需要创建变量来查找最后一个和第一个空行并使用它来代替：

Sub AddNewRow()


' AddNewRow Macro

Dim LastRw As Long, EmptyRw As Long

EmptyRw = WorksheetFunction.CountA(Range("F:F")) + 1
LastRw = WorksheetFunction.CountA(Range("F:F"))

Cells(EmptyRw, 6).Select
ActiveSheet.Unprotect
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Cells(LastRw, 6).Select
Selection.AutoFill Destination:=Range(Cells(LastRw, 6), Cells(EmptyRw, 6)), Type:=xlFillDefault
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
    , AllowFormattingCells:=True, AllowDeletingRows:=True, AllowSorting:=True _
    , AllowFiltering:=True

End Sub

Answer 2

可以使用CurrentRegion 查找最后一行并从那里填写...

Sub AddNewRow()

ActiveSheet.Unprotect
ActiveSheet.Range("A1").CurrentRegion.Offset(ActiveSheet.Range("A1").CurrentRegion.Rows.Count - 1).Resize(2).FillDown
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
    , AllowFormattingCells:=True, AllowDeletingRows:=True, AllowSorting:=True _
    , AllowFiltering:=True

End Sub

如果工作表内容不是在单元格A1 中或旁边开始，则需要更改Range("A1")