Microsoft 365 ajouter des lignes vides

Sub compléter()
    Dim Wsh As Worksheet, Dc As Object, Tb, NbLgn As Long, NbCol As Long, LgnBas As Long, NbPlus As Long
    
    Set Wsh = ThisWorkbook.Worksheets("Liste du personnel pour CSE")
    
    Set Dc = CreateObject("Scripting.Dictionary")
    For i = 50000 To 57400: Dc(i) = i: Next
    
    With Wsh
        LgnBas = .Cells(.Rows.Count, 1).End(xlUp).Row
        Tb = .Range(.Cells(2, 1), .Cells(LgnBas, 1))
        NbLgn = UBound(Tb)
        NbCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    End With
    
    With WorksheetFunction
        Tb = .Unique(.Sort(Tb))
    End With
    For i = 1 To UBound(Tb)
        Dc.Remove (Tb(i, 1))
    Next
    NbPlus = Dc.Count
    With Wsh
        .Cells(LgnBas + 1, 1).Resize(NbPlus) = WorksheetFunction.Transpose(Dc.Keys)
        With .Sort
            .SortFields.Clear
            .SortFields.Add Key:=Wsh.Cells(1, 1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SetRange Wsh.Cells(1, 1).Resize(NbLgn + NbPlus + 1, NbCol)
            .Header = xlYes
            .Apply
        End With
    End With
    With Wsh.Cells(2, 1).Resize(NbLgn + NbPlus, NbCol)
        .Interior.Color = RGB(247, 247, 247)
        .Borders.LineStyle = xlContinuous
        .Borders.Color = RGB(221, 221, 221)
    End With
    Wsh.Cells(2, 1).Resize(NbLgn + NbPlus, 3).HorizontalAlignment = xlLeft
    With Wsh.Cells(2, 4).Resize(NbLgn + NbPlus, 2)
        .NumberFormat = "dd/mm/yyyy"
        .HorizontalAlignment = xlCenter
    End With
End Sub