添加新行按钮，而不是同时处理两张纸

Question

您好，有添加新行的代码。当我单击该按钮时，代码将运行以根据我在编码中设置的内容添加新行。现在，我想要的是，当我单击按钮时，工作表 1 中的行和工作表 2 中的行将添加在一起。我将按钮放在第 1 页上。

我需要添加什么项目，以便我放置在工作表 1 中的按钮自动适用于工作表 1 和工作表 2。例如，如果我添加 3 个新行，工作表 1 和工作表 2 也会添加新的 3 行。

这是我的代码。

    Sub RectangleRoundedCorners7_Click()
    Dim tmpStr As String, howMany As Integer
Dim i As Long
    tmpStr = InputBox("How many row do you want to add?                                                                                       {Reminder: not to add row if lowest cell still blank}")
        If Len(tmpStr) = 0 Then
        howMany = 0
    Else
        howMany = CInt(tmpStr)
    End If
    With Range("B7").End(xlDown).EntireRow
        For i = 1 To howMany
              .Copy
            .Offset(1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            .Offset(1).SpecialCells(xlCellTypeConstants).Value = ""
             Application.CutCopyMode = False
      On Error GoTo 0
        Next
    End With
End Sub

谢谢你。

Answer 1

将现有 Sheet1 代码封装在循环中，以同样方式处理 Sheet2。

Sub RectangleRoundedCorners7_Click()
    Dim tmpStr As String, howMany As Integer
    Dim i As Long, Sht As String
    tmpStr = InputBox("How many row do you want to add?)                                                                                       {Reminder: not to add row if lowest cell still blank}")
    If Len(tmpStr) = 0 Then
        howMany = 0
    Else
        howMany = CInt(tmpStr)
    End If
    For Each Sht In Array("Sheet1", "Sheet2")
        With Sheets(Sht).Range("B7").End(xlDown).EntireRow
            For i = 1 To howMany
                Application.CutCopyMode = False
                .Copy
                .Offset(1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                .Offset(1).SpecialCells(xlCellTypeConstants).Value = ""
            Next
        End With
    Next
End Sub