VBA 添加插入行

Question

我需要在包含总计的行之前添加一个新行，但是代码在包含总计的行之后添加新行，并且我需要将其添加在包含总计的行之前，并且在新时还更改加上公式范围值行已添加。

VBA代码：

Private Sub IncidentesFR_Open()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim rng As Range, f As Range, r As Range  
  Dim i As Long, j As Long, n As Long, m As Long, d As Long
  Dim newRow As ListRow
  Dim cell As String
  
  Application.ScreenUpdating = False
  
  Set sh1 = Sheets("Incidentes")
  Set sh2 = Sheets("Incidentes FR")
  
  n = sh1.ListObjects(1).ListColumns("Situation").Index
  
  Set r = sh1.Columns(n)
  Set f = r.Find("Out of the Rules2", , xlValues, xlWhole, , , False)
  If Not f Is Nothing Then
    cell = f.Address
    Do
      For j = 2 To sh2.Range("B" & Rows.Count).End(3).Row
        If sh2.Range("A" & j).Value = "" Then
          Set newRow = sh2.ListObjects(1).ListRows.Add '*****  does the command to add the new row have to be indexed?
          sh1.Rows(f.Row).Copy sh2.Range("A" & j)
          Exit For
        End If
      Next
      Set f = r.FindNext(f)
    Loop While f.Address <> cell
  End If

  Application.ScreenUpdating = True
End Sub

如何在表格的正确位置创建行，并在添加新行时更改公式范围值？看图。

Answer 1

此代码模式会将行插入到表的末尾。 要获得表中正确的行数，请从表中删除 TOTAL 2024 行

• 表格工具 -> 调整最后一行的大小并减少 1。

也许英文名称不同（我的excel不是那样的）

 Private Sub IncidentesFR_Open()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim rng As Range, f As Range, r As Range
  Dim i As Long, j As Long, n As Long, m As Long, d As Long
  Dim newRow As ListRow
  Dim cell As String
  
  'Application.ScreenUpdating = False
  
  Set sh1 = Sheets("Munka2") ' Sheets("Incidentes")
  Set sh2 = Sheets("Munka1") 'Sheets("Incidentes FR")
  
  n = sh1.ListObjects(1).ListColumns("Situation").Index
  
  Set r = sh1.Columns(n)
  Set f = r.Find("Out of the Rules2", , xlValues, xlWhole, , , False)
  If Not f Is Nothing Then
    cell = f.Address
    Do
      'For j = 2 To sh2.Range("B" & Rows.Count).End(3).Row
        'If sh2.Range("A" & j).Value = "" Then
          Set newRow = sh2.ListObjects(1).ListRows.Add '*****  does the command to add the new row have to be indexed?
          sh1.Rows(f.Row).Copy newRow.Range ' sh2.Range("A" & j)
        '  Exit For
        'End If
      'Next
      Set f = r.FindNext(f)
    Loop While f.Address <> cell
  End If

  Application.ScreenUpdating = True
End Sub