Imprimer une liste filtrée

Hello,

https://www.cjoint.com/c/NJFjxpvCGlo

Option Explicit

Sub ExtraireValeursUniques()

    ' *** à adapter ***

    Const Nom_Feuille As String = "Feuil1"

    Dim Feuille_Source As Worksheet

    Dim Plage_Source As Range

    Dim Cell_Source As Range

    Dim Données_Source As Object

    Dim Liste_Données() As Variant

    Dim i As Integer

    Dim Key

    ' Définir la feuille et la Plage_Source (ici colonne A, mais adaptable)

    Set Feuille_Source = ThisWorkbook.Worksheets(Nom_Feuille)

    Set Plage_Source = Feuille_Source.Range("A1:A" & Feuille_Source.Cells(Feuille_Source.Rows.Count, 2).End(xlUp).Row) ' Plage_Source des données

    ' Créer un dictionnaire pour stocker les valeurs uniques

    Set Données_Source = CreateObject("Scripting.Dictionary")

    ' Remplir le dictionnaire avec les valeurs uniques

    For Each Cell_Source In Plage_Source

        If Not Données_Source.exists(Cell_Source.Value) And Not IsEmpty(Cell_Source.Value) Then

            Données_Source.Add Cell_Source.Value, Nothing

        End If

    Next Cell_Source

    ' Transférer les valeurs uniques du dictionnaire dans le tableau Liste_Données

    ReDim Liste_Données(1 To Données_Source.Count)

    i = 1

    For Each Key In Données_Source.keys

        Liste_Données(i) = Key

        i = i + 1

    Next Key

    ' Filtrer et imprimer pour chaque valeur unique

    For i = LBound(Liste_Données) To UBound(Liste_Données)

        ' Appliquer le filtre pour la valeur unique

        Feuille_Source.Range("A1").AutoFilter Field:=1, Criteria1:=Liste_Données(i)

        ' Imprimer la plage filtrée

        ' apercu simple

        Feuille_Source.PrintPreview (True)

        ' ou : impression directe

        'Feuille_Source.PrintOut

        ' Supprimer le filtre

        'Feuille_Source.AutoFilterMode = False

    Next i

End Sub