XL 2010 Macro trier les données géographiques

Sub extraction()

    Dim Entêtes As Variant
    Dim plg As Range
    Dim dic As Object
    Dim feuille As Worksheet, wsTmp As Worksheet
    
    Dim items As Variant, item As Variant
    
    '
    ' initialisation d'un dictionnaire pour extraction d'une liste unique de sites
    Set dic = CreateObject("scripting.dictionary")
    '
    ' Tableau des entêtes de colonnes
    Entêtes = Array("CODE POLE ", "LIB POLE ", "CODE UF", "LIB UF", "BUDGET  MIPIH", "SITE")
    '
    ' Récupération des valeurs de la dernière colonne à partir de la troisième ligne
    With ThisWorkbook.Sheets("Base").Range("A1").CurrentRegion
        items = .Offset(2).Resize(.Rows.Count - 2).Columns(.Columns.Count).Value
        Set plg = .Offset(1).Resize(.Rows.Count - 1)
    End With
    '
    ' Extraction des items unique de la colonne site
    For Each item In items: dic(item) = item: Next
    items = dic.Keys
    '
    ' Récupération ou création de la feuille temporaire
    Set wsTmp = FeuilleParNom("Temp")
    '
    ' Entête de la zone de critère
    wsTmp.Range("A1") = "Site"
    
    For Each item In items
        '
        ' Récupétation d'une feuille localisée
        Set feuille = FeuilleParNom(IIf(IsEmpty(item), "Vides", item))
        
        If Not feuille Is Nothing Then
            '
            ' Valeur du critère d'extraction sur la feuille temporaire
            wsTmp.Range("A2") = IIf(IsEmpty(item), "=", item)
            '
            ' Placement de l'entête de tableau dans la feuille localisée
            feuille.Range("A1").Resize(, 6) = Entêtes
            plg.AdvancedFilter xlFilterCopy, wsTmp.Range("A1:A2"), feuille.Range("A1").Resize(, 6)
        End If
    Next item
    
    '
    ' Suppression de la feuille temporaire
    Application.DisplayAlerts = False
    wsTmp.Delete
    Application.DisplayAlerts = True
    
End Sub