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

尝试插入新行（不使用表格功能），然后在清除内容的同时从上方复制公式和格式

1 个答案: