XL 2019 Eclater les catégories d'un tableau

Sub Modifier()
Dim P As Range, i&
Set P = [A1].CurrentRegion
Application.ScreenUpdating = False
P.Rows(P.Rows.Count + 1).Resize(Rows.Count - P.Rows.Count - P.Row + 1).Delete xlUp 'RAZ
P.Copy P(P.Rows.Count + 2, 1)
Set P = P(P.Rows.Count + 2, 1).Resize(P.Rows.Count, P.Columns.Count)
P.Sort P.Columns(1), xlAscending, Header:=xlYes 'tri
For i = P.Rows.Count To 2 Step -1
    If P.Cells(i, 1) <> P.Cells(i - 1, 1) Then
        P.Rows(i).Insert xlDown
        P.Rows(1).Copy P.Rows(i)
        P.Cells(i, 1) = P.Cells(i + 1, 1)
        P.Cells(i + 1, 1) = ""
    Else
        P.Cells(i, 1) = ""
    End If
Next
P.Rows(1).Delete xlUp
End Sub