Microsoft 365 Macro pour balayer une sélection de plusieurs lignes et colonnes et recherche de mots clefs

Sub TraiteNouveau()
    Dim cell As Object, NomFeuille$, LigEcr%
    NomFeuille = "CARGO"
    LigEcr = 1                              ' N° ligne écriture
    Sheets(NomFeuille).[A:A].ClearContents  ' Effacement données
    For Each cell In Selection
        If cell.Value Like NomFeuille & "*" Then  ' Si la cellule contient le marqueur
            Sheets(NomFeuille).Cells(LigEcr, "A") = cell.Value    ' On va écrire le nom en CARGO
            LigEcr = LigEcr + 1     ' On incrémente le pointeur d'écriture
            End If
    Next cell
    ' Suppression doublons
    Sheets(NomFeuille).Select
    Columns("A:A").Select
    ActiveSheet.Range("$A$1:$A$1000").RemoveDuplicates Columns:=1, Header:=xlNo
    ' Tri alpha
    ActiveWorkbook.Worksheets(NomFeuille).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(NomFeuille).Sort.SortFields.Add Key:=Range("A1:A1000"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets(NomFeuille).Sort
        .SetRange Range("A1:A1000")
        .Header = xlGuess: .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin: .Apply
    End With
    Range("A1").Select
End Sub