XL 2019 supprimer lignes vides qui ont été coupées - collées

Sub Copie()
Dim t, ncol%, P As Range, nlig&, i&, deb&, derlig&
t = Timer
Application.ScreenUpdating = False
On Error Resume Next 'si une feuille n'existe pas ou s'il n'y a aucune SpecialCell
With [Tableau1].ListObject.Range 'tableau structuré
    .Parent.Unprotect ""
    ncol = .Columns.Count
    '---création des tableaux---
    Workbooks.Add 'document vierge auxiliaire
    Set P = [A1].Resize(.Rows.Count, ncol)
    P = .Value 'copie les valeurs
    P.Sort P(1, 8), xlAscending, P(1, 11), , xlAscending, Header:=xlYes 'tri sur 2 colonnes
    nlig = Application.CountIf(P.Columns(8), "?*")
    Set P = P.Resize(nlig)
    P.Rows(nlig + 1) = ""
    For i = 2 To nlig
        If P(i, 11) <> P(i - 1, 11) Then deb = i
        If P(i, 11) <> P(i + 1, 11) Then
            With ThisWorkbook.Sheets(P(i, 11).Value)
                derlig = .Cells(.Rows.Count, 11).End(xlUp).Row
                .Cells(derlig + 1, 1).Resize(i - deb + 1, ncol - 1) = P.Rows(deb).Resize(i - deb + 1).Value
            End With
        End If
    Next
    ActiveWorkbook.Close False 'ferme le document auxiliaire
    '---suppression des lignes---
    .Columns(8).Replace "oui", "#N/A", MatchCase:=False
    .Sort .Columns(8), xlAscending, Header:=xlYes 'tri pour regrouper et accélérer
    Intersect(.Columns(8).SpecialCells(xlCellTypeConstants, 16).EntireRow, .Cells).Delete xlUp
    .Parent.Protect ""
End With
MsgBox "Transfert effectué en " & Format(Timer - t, "0.00 \sec"), vbInformation, "Transfert"
End Sub