XL 2010 Macro trier les données géographiques

[rom77100]

Bonjour à toutes et à tous,

Pour commencer, je vous souhaite mes meilleurs vœux pour cette nouvelle année qui débute.

En ce qui concerne ma demande, j'aimerais sur mon fichier pouvoir séparer en un clic les données par lieux géographique par onglet. Je m'explique, j'ai un fichier avec pas mal de colonne, et sur la colonne T le site.

J'aimerais pouvoir regrouper les données par lieux géographique (en supprimant les autres sites) et ce par onglet en laissant uniquement les colonnes E, F, N, O, Q . Je vous joins le fichier pour que vous compreniez plus simplement.

Un grand merci par avance pour vos retour.

Bien cordialement,
Romain

 

[Hasco]

Bonjour,

Dans le classeur joint vous trouverez un bouton qui lancera la macro ci-dessous.
Comme excel ne sait pas trop reconnaître (pour les filtre avancés) les entêtes de tableau dont les cellules sont fusionnées, j'ai défusionné les entêtes de votre tableau de la feuille base.

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

A vous de parfaire.

Cordialement

 

[Lolote83]

Salut à tous,
Voici ma contribution.
@+ Lolote83