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