XL 2010 extraction de donnees selon criteres

Sub Transfert()
' Tranfert des matrices
    DL = Range("A65500").End(xlUp).Row
    Range("A4:G" & DL).Copy
    Windows("exemple (15).xlsm").Activate
    Range("A4").Select: ActiveSheet.Paste
' Traitement matrice en réception
    Range("A" & DL + 1 & ":G1000").ClearContents
    With ActiveSheet.UsedRange
    Application.ScreenUpdating = False
    .Columns(2).EntireColumn.Insert                 'insère une colonne auxiliaire
    With Range("B4:B" & DL)
        .FormulaR1C1 = "=IF(RC[6]=""ok"","""",1)"   ' insère formules
        .Value = .Value                             'supprime les formules et met les valeurs
        .EntireRow.Sort .Cells, xlDescending        'tri pour regrouper et accélérer
        On Error Resume Next                        'si aucune SpecialCell
        .SpecialCells(xlCellTypeConstants, 1).EntireRow.Delete
    End With
    Range("B:B").Delete: [A1].Select                'supprime la colonne auxiliaire
End With
With ActiveSheet.UsedRange: End With                'actualise les barres de défilement
End Sub