VBA 添加行按钮

Question

我有 VBA 编码来添加行，它复制第 8 行以及格式和公式。 我还创建了输入框来添加需要添加的行数。

 Sub RectangleRoundedCorners7_Click()
Dim howMany As Long
howMany = InputBox("How many rows?")
Dim i As Long
For i = 1 To howMany
Range("A8:A9").Select
Range("A8").Activate
   With ActiveCell.EntireRow
      .Copy
      .Offset(1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
       On Error Resume Next
      .Offset(1).SpecialCells(xlCellTypeConstants).Value = ""
      Application.CutCopyMode = False
      On Error GoTo 0
   End With
   Next
   
End Sub

问题是，当我添加新行时，该行将位于第 8 行下方。这使得我在添加新行之前在单元格中写下的项目向下并创建空格，就像图像一样。

我想要的是新添加的行始终位于包含单词“Space”的行的顶部。意思是说，新行应始终添加到我的表格的最低位置，但在包含单词“space”或行“Total”之前。

请帮忙。谢谢你。

Answer 1

首先避免使用

Select

和

Activate

方法。大多数时候，他们什么也没提供。只需直接提及您需要的单元即可。在这种情况下，您需要包含 A 列中的数据的最后一个单元格的行。

此语句：

Range("A1").End(xlDown)

将在 2 个条件下从 A 列（包含数据的最后一个单元格）返回。

1. 单元格 A2 不为空。
2. A列的数据是连续的，即中间没有空白单元格。

据我所知，您的数据满足这些条件，因此这可以完成工作。

Sub RectangleRoundedCorners7_Click()
Dim howMany As Long
Dim i As Long
    howMany = InputBox("How many rows?")
    With Range("A1").End(xlDown).EntireRow
        For i = 1 To howMany
            .Offset(1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Next
    End With
End Sub