Jak usunąć wszystkie oprócz pierwszych dwóch wierszy w tabeli (nagłówki to pierwszy wiersz)

Mam tabelę, w której ktoś inny wkleja nowe dane do cotygodniowego. Dane wklejane co tydzień będą zmieniać rozmiar według wierszy, ale nie kolumn. Zautomatyzowałem ten proces do momentu, w którym trzymam pierwszy wiersz, aby formuły nie zostały usunięte. Wszystko to odbywa się za pomocą przycisku, do którego przypisałem kod. Teraz muszę usunąć pozostałe wiersze tabeli. Oto kod, który mam do tej pory, który działa:

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 () - Nagrałem makro i pierwszy wiersz kodu powtarza się dla tylu wierszy w tabeli, które zostaną usunięte, które zmieniają się przy każdym użyciu, więc nie będą działać. Pierwszy wiersz do usunięcia zawsze pozostanie taki sam: wiersz 5. Jest to ostatni wiersz, który kod musi uwzględnić jako dynamiczny.

Jak usunąć zaznaczenie dla środowiska dynamicznego? Wielkie dzięki!

To powiela to, co robi Twoje nagranie - usuń ostatni wiersz tabeli, aż pozostanie tylko jeden wiersz

Wyłącza się ScreenUpdatingi Calculationprzyspiesza; na końcu włącza je z powrotem

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

Przed

Po

.

Table( ListObject) struktura