Vba pour Excel macro de tri des lignes

Private Sub cbGenerateDN_Click()
Dim MaxLig As Long, Lig As Long, Col As Integer, IxLig As Integer
    Application.ScreenUpdating = False
    Worksheets("PackingList").Columns("A:b").Copy _
        Destination:=Worksheets("Delivery Note").Columns("A:b")
    Worksheets("PackingList").Columns("d").Copy _
        Destination:=Worksheets("Delivery Note").Columns("c")

'Met les sous-item sur la même ligne
    With Sheets("Delivery Note")
        .Select
        For Lig = 2 To .Range("B65536").End(xlUp).Row
            If .Cells(Lig, 2) = "" Then Exit For
            If .Cells(Lig, 1) = "" Then
                .Cells(Lig, 2).Copy .Cells(Lig - 1, Col)
                .Cells(Lig, 3).Copy .Cells(Lig - 1, Col + 1)
                .Rows(Lig).Delete
                Col = Col + 2: Lig = Lig - 1
            Else
                Col = 4
            End If
        Next Lig
'Trier la liste.
    .Range("B2").Select
    Selection.Sort Key1:=.Range("B2"), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'Renumérote les lignes.
    For Lig = 2 To .Range("B65536").End(xlUp).Row
        .Cells(Lig, 1) = Lig - 1
    Next Lig
'Remettre les sous-item.
        Col = 4: MaxLig = .Range("D65536").End(xlUp).Row: IxLig = 1
        For Lig = MaxLig To 2 Step -1
            If .Cells(Lig, 4) <> "" Then
                While Cells(Lig, Col) <> ""
                    .Rows(Lig + IxLig).Insert
                    Cells(Lig, Col).Copy .Cells(Lig + IxLig, 2)
                    Cells(Lig, Col + 1).Copy .Cells(Lig + IxLig, 3)
                    Col = Col + 2: IxLig = IxLig + 1
                Wend
                Col = 4: IxLig = 1
            End If
        Next Lig
        MaxLig = .Range("D65536").End(xlUp).Row
        .Range(Cells(1, 4), Cells(MaxLig, 8)).Clear
    End With
    Application.ScreenUpdating = True

End Sub