在所有工作表上添加带有公式的新行

Question

我有一本Excel工作簿，总共11张工作表。我目前具有添加新行的功能，但是我需要新行来保留前一个/后一个的公式，该如何处理？

• 当前使用SelectionChanged作为特定单元格制作的
• 我必须将行添加到“当前选定单元格/行”所在的位置/是

当前添加行的代码，根本不包括公式：

Sub InsertRow(ByVal selection)

    Dim cs As String
    cs = ActiveSheet.Name
    Dim y As Integer
    y = selection
    If MsgBox("Add Row " & y & " in all Sheets?", _
    vbYesNo, "Add Row") = vbNo Then Exit Sub
    Application.ScreenUpdating = False
    Dim r As Range
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        ws.Activate
        Set r = ActiveSheet.Range("A" & y)
        If y < 7 Then GoTo circumv 'Not to insert in Headers
        Range("A" & y).EntireRow.Insert

circumv:
    Next ws
    Sheets(cs).Activate
    Application.ScreenUpdating = True

End Sub

Answer 1

我确实直接在VBA编辑器中启动了宏。您可能要启动它，例如双击。看到第二个答案！

Public Sub InsertMyRow() '(ByVal MyRange As Range)

    Dim cs As String
    Dim actCell As Range
    cs = ActiveSheet.Name
    Dim y As Integer
    y = ActiveCell.Row
    If MsgBox("Add Row " & y & " in all Sheets?", _
    vbYesNo, "Add Row") = vbNo Then Exit Sub
    Application.ScreenUpdating = False
    Dim r As Range
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        ws.Activate
        Set actCell = ActiveCell
        Set r = ActiveSheet.Range("A" & y)
        If y < 7 Then GoTo circumv 'Not to insert in Headers
        Range("A" & y).EntireRow.Insert
        Range("A" & y - 1).EntireRow.Copy
        Range("A" & y).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False

        If Not (IsEmpty(Range("A" & y + 1))) Then
            Range("A" & y - 1).EntireRow.Copy
            Range("A" & y + 1).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False
            Application.CutCopyMode = False
        End If
        actCell.Select

circumv:
    Next ws
    Sheets(cs).Activate
    Application.ScreenUpdating = True

End Sub

Answer 2

您必须直接在要对双击产生反应的每个工作表中直接添加此代码！

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    'MsgBox ("Click")
    Call InsertMyRow
End Sub

双击工作表以在其中输入代码