Como excluir todas as primeiras duas linhas de uma tabela (cabeçalhos é a primeira linha)

Question

Eu tenho uma tabela em que outra pessoa colará novos dados em semanalmente. Os dados que estão sendo colados a cada semana serão alterados em tamanho por linhas, mas não por colunas. Eu automatizei o processo até o ponto em que mantenho a primeira linha para que as fórmulas não sejam removidas. Tudo isso é feito através de um botão ao qual eu atribuí o código. Agora preciso excluir as linhas restantes da tabela. Aqui está o código que tenho até agora que funciona:

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 () - Eu gravei uma macro ea primeira linha de repetições de código para quantas linhas na tabela forem excluídas, o que mudará com cada uso, portanto, não funcionará. A primeira linha a ser excluída sempre permanecerá a mesma: linha 5. É a última linha que o código precisa para ser dinâmico.

Como excluo a seleção de um ambiente dinâmico? Muito obrigado!

    

Answer 1

Isso duplica o que sua gravação faz - exclui a última linha da tabela até que haja apenas uma linha restante

Desativa ScreenUpdating e Calculation para torná-lo mais rápido. no final, volta-os para

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

Antes

Depois

.

Table(ListObject)estrutura