尝试插入一个新行（不使用表函数），然后从上面复制公式和格式，同时清除内容

Question

我正在尝试向此宏添加一段代码，以复制上述单元格中的公式和格式，而单元格中没有特定内容。我不想创建一个表。数据范围为 A:T，理想情况下，所有公式都将进入新行。

我尝试过搜索这么多不同类型的代码，但几乎所有代码都基于表格，我不打算使用。

Private Sub CommandButton1_Click()
    Dim rowNum As Integer
    On Error Resume Next
    rowNum = Application.InputBox(Prompt:="Enter Row Number where you want to add a row:", _
                                    Title:="Kutools for excel", Type:=1)
    Rows(rowNum & ":" & rowNum).Insert Shift:=xlDown
End Sub

我希望附加代码会在新行中插入正确的格式和公式。然后，您输入行的提示应取指定单元格上方的行并复制格式和公式。

Answer 1

首先你可以使用

来整理你的代码

Rows(rowNum).Insert Shift:= xlDown

假设您想要复制格式和公式（非常数）并且不介意其他属性（例如验证）也可以使用（我评论了 On Error Resume Next 语句 - 至少在测试时）。

编辑1：

Dim rowNum As Long

'On Error Resume Next

rowNum = Application.InputBox(Prompt:="Enter Row Number where you want to add a row:", _
                                    Title:="Kutools for excel", Type:=1)
If rowNum < 1 Then Exit Sub             

With Rows(rowNum)
    .Copy
    .Offset(1, 0).Insert
    .Offset(1, 0).SpecialCells(xlConstants).ClearContents
End With

如果您想避免在代码中使用复制/粘贴，您可以使用：

Dim rowNum As Long
Dim cl As Range

'On Error Resume Next

rowNum = Application.InputBox(Prompt:="Enter Row Number where you want to add a row:", _
                                    Title:="Kutools for excel", Type:=1)
If rowNum < 1 Then Exit Sub             'This code will fail if you act on rownum 1 - you could also show an error message to the user

With Rows(rowNum)
    .Offset(1, 0).Insert
    For Each cl In .SpecialCells(xlFormulas)
        cl.Offset(1, 0).Formula = cl.Formula
    Next cl
End With

End Sub