inserer des lignes automatiquement

Sub manquants()
Dim debut As Long, fin As Long, i As Long, a, e
    Application.ScreenUpdating = False
    debut = Range("a1").Value
    fin = Range("a" & Rows.Count).End(xlUp).Value
    With CreateObject("Scripting.Dictionary")
        For i = debut To fin
            .Item(i) = Empty
        Next
        a = Range("a1", Range("a" & Rows.Count).End(xlUp)).Value
        For Each e In a
            If .exists(e) Then .Remove e
        Next
        If .Count > 0 Then
            Range("a" & Rows.Count).End(xlUp)(2).Resize(.Count).Value = _
            Application.Transpose(.keys)
        End If
    End With
    With Range("a1").CurrentRegion
        .Sort key1:=Range("a1"), order1:=1, Header:=1
    End With
    Application.ScreenUpdating = True
End Sub