Как удалить все, кроме первых двух строк в таблице (заголовки - первая строка)

Question

У меня есть таблица, в которую кто-то еще будет вставлять новые данные в еженедельник. Данные, вставляемые каждую неделю, изменяются в размере по строкам, но не по столбцам. Я автоматизировал процесс до того момента, когда я сохраню первый ряд, чтобы формулы не удалялись. Все это делается с помощью кнопки, которой я назначил код. Теперь мне нужно удалить оставшиеся строки таблицы. Вот код, который у меня пока работает:

Sub ShrinkTable()
    Range("RDNPPD[[#Headers],[Follow Up by Corp Security]]").Select
    ActiveSheet.ListObjects("RDNPPD").ListRows(ActiveCell.Row - 
    1).Range.Select
    Range(Selection, Selection.End(xlDown)).Select    
End Sub

Sub DeleteRows()
    Selection.ListObject.ListRows(2).Delete
    Selection.ListObject.ListRows(2).Delete
    Selection.ListObject.ListRows(2).Delete
    Range("RDNPPD[[#Headers],[Follow Up by Corp Security]]").Select
End Sub

RE: Sub DeleteRows() - я записал макрос, и первая строка кода повторяется для такого количества строк в таблице, которые удаляются, что будет меняться при каждом использовании, поэтому не будет работать. Первая строка, которая будет удалена, всегда останется прежней: строка 5. Это последняя строка, которую код должен учитывать, чтобы быть динамическим.

Как удалить выборку для динамического окружения? Большое спасибо!

Answer 1

Это дублирует то, что делает ваша запись - удаляйте последнюю строку таблицы, пока не останется только одна строка

ScreenUpdating и Calculation чтобы сделать это быстрее; в конце концов он снова включается

---

Option Explicit

Public Sub ShrinkTable()

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    With ThisWorkbook.Worksheets("Sheet3")              'Update Sheet Name
        If .ListObjects.Count > 0 Then
            With .ListObjects("RDNPPD")
                While .ListRows.Count > 1               'Delete last row until first
                    .ListRows(.ListRows.Count).Delete
                Wend
            End With
        End If
    End With

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub

---

До

После

,

Структура Table (ListObject)

---