VBA - FILTRER EN FONCTION D'UNE LISTE

Le 19/01/2017 à 14:31

Bonjour,

J'utilise une macro qui me permet de "découper" une grille excel en fonction de la colonne N. Pour chaque élément différent je fais un copier coller et enregistrement en CSV.

Actuellement j'ai une 15ène de variable possible. Je les ai toute intégré à la macro mais afin de l'optimiser je voudrai que le filtre ce fasse en fonction de la liste :

Voici le code (avec explication de chaque étape) : je pense que c'est dans la partie "Criteria1" qui faut créer une boucle avec 1er mot de la liste, 2ème ... etc...

Sub ECRITURE_CSV()

' Ecriture CSV (il vient chercher a zone à prendre dans un fichier de travail puis ouvre un nouveau classeur)
        Sheets("ECRITURE").Activate
        DerniereLigne = ActiveSheet.UsedRange.Rows.Count
        Range("A1:N" & DerniereLigne).Copy
        Workbooks.Add
        Range("A1").Select
        ActiveSheet.Paste
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Range("A1").Select

'LISTE SOCIETE (création de la liste en colonne N)
        Sheets.Add
        Sheets("Feuil2").Name = "LISTE SOCIETE"
        Sheets("Feuil1").Activate
        DerniereLigne = ActiveSheet.UsedRange.Rows.Count
        Range("N2:N" & DerniereLigne).Copy
        Sheets("LISTE SOCIETE").Activate
        Range("A1").Select
        ActiveSheet.Paste
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

        ActiveSheet.Range("A1:A" & DerniereLigne).RemoveDuplicates Columns:=1, Header:=xlNo

'nom du fichier (détermine le nom des futurs fichier CSV)

        Dim stDateHeureExport As String
        stDateHeureExport = "_" & _
        Format(Now, "dd-mm-yyyy" & " à " & _
"hh""h""mm""'""ss""''""")

        Dim Libelle As String
        Libelle = InputBox("Libelle ?", "Titre") 'La variable reçoit la valeur entrée dans l'InputBox
        If resultat <> "" Then 'Si la valeur est différente de "" on affiche le résultat
        MsgBox resultat
        End If

'CSV PAR FILTRE (application du filtre en fonction de la liste)

        Sheets("Feuil1").Select
        Range("A1:N1").Select
        Selection.AutoFilter
        Selection.AutoFilter Field:=14, Criteria1:="ELEMENT 1 DE LA LISTE"
        DerniereLigne = ActiveSheet.UsedRange.Rows.Count
        Range("A1:N" & DerniereLigne).Copy
    'ouverture du classeur
        Workbooks.Add
        Range("A1").Select
        ActiveSheet.Paste

Site = Range("N2").Value
        NomCompletFichier = Libelle & "_" & Site & "_" & stDateHeureExport

        chemin = "Z:\Service Support\Comptabilité\Z_FICHIER IMPORTATION CSV\"

        ActiveWorkbook.SaveAs Filename:=chemin & NomCompletFichier, FileFormat:=xlCSV, local:=True

        ActiveWorkbook.Close SaveChanges:=False

'Et maintenant il faut faire une boucle pour le 2ème de la liste puis le 3ème etc

End Sub

Merci d'avance pour votre aide

Le 21/01/2017 à 22:46

Bonsoir,

sachez que je fais ce que je peux avec mes maigres connaissances...

Mais en faisant de la tambouille ceci pourait marcher :

[...]
Dim Elément As Variant, Tablo() As Variant, NB_Elément As Integer, Cpt As Integer
For Each Elément In ActiveSheet.AutoFilter.Filters.Item(14).Criteria1
    Tablo(NB_Elément) = Elément
Next Elément
[...]
For Cpt = 0 To UBound(Tablo)
[...]
Selection.AutoFilter Field:=14, Criteria1:=Tablo(Cpt)
[...]
Next Cpt
[...]

@ bientôt

LouReeD

Le 22/01/2017 à 20:34

Bonjour et bienvenu(e),

Merci de joindre un petit fichier à ta demande.

Cdlt.

Le 24/01/2017 à 16:05

Bonjour Jean Eric,

Je viens de modifier mon fichier afin de pouvoir le mettre en ligne (données confidentielles).

Dans le menu VBA, le module 1 correspond à ce que j'utilise aujourd'hui, n'énumère dans la macro l'ensemble des sociétés susceptible de figurer dans le fichier.

dans le module 2 j'ai essayé de faire quelque chose mais rien de va. Je voudrai qu'il récupère les sociétés figurant en colonne N, qu'il filtre ensuite chaque société et crée un CSV pour chacune d'entre elle.

Le fichier en PJ.

Je vous remercie pour votre aide.

Cordialement,

65test-filtre-liste.xlsm (36.18 Ko)
Le 24/01/2017 à 18:06

Bonsoir,

j'ai l'impression d'être transparent.... 

'CSV PAR FILTRE (application du filtre en fonction de la liste)
[...]
Dim Elément As Variant, Tablo() As Variant, NB_Elément As Integer, Cpt As Integer
For Each Elément In ActiveSheet.AutoFilter.Filters.Item(14).Criteria1
    Tablo(NB_Elément) = Elément
Next Elément
[...]
For Cpt = 0 To UBound(Tablo)
[...]
Selection.AutoFilter Field:=14, Criteria1:=Tablo(Cpt)
[...]
Next Cpt
[...]
'Et maintenant il faut faire une boucle pour le 2ème de la liste puis le 3ème etc

je n'ai pas recopier tout le code mais la boucle est surlignée en vert, avec un filtre sur la colonne 14 si je ne me suis pas trompé.

Avez vous essayé ?

@ bientôt

LouReeD

Le 24/01/2017 à 23:25

Non pas transparent.

oui j'ai essayé mais pas réussi à la mettre en oeuvre, je n'ai jamais eu de formation en VBA et j'ai créé mes macro en m'aidant d'information trouvé sur internet.

Je pense que mon problème c'est que je ne sais pas ou la positionner dans le code. sur votre 2ème code, je vois les "titres" de mon code. Je vais refaire des essais demain.

Merci de votre aide

Le 25/01/2017 à 00:38

Bonjour,

Une proposition à étudier et à adapter.

Cdlt.

Option Explicit

Public Sub Creer_CSV()
Dim wb As Workbook
Dim ws As Worksheet
Dim Dict As Object
Dim Rng As Range, Rng2 As Range
Dim n As Long, lCol As Long, I As Long
Dim tbl, k
Dim sPath As String, sFilename As String

    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With

    Set wb = ActiveWorkbook
    Set ws = wb.Worksheets("ECRITURE")
    Set Dict = CreateObject("Scripting.Dictionary")
    sPath = wb.Path & Application.PathSeparator
    'sPath = "Z:\Service Support\Comptabilité\Z_FICHIER IMPORTATION CSV\"
    lCol = 14

    With ws
        If .FilterMode Then .ShowAllData
        Set Rng = .Cells(1).CurrentRegion
        n = Rng.Rows.Count
        tbl = .Cells(lCol).Resize(n)
    End With
    For I = 2 To UBound(tbl)
        Dict(tbl(I, 1)) = ""
    Next I

    For Each k In Dict.keys
        sFilename = k & " " & Format(Now, "yyyymmdd hh-mm-ss")
        Rng.AutoFilter field:=lCol, Criteria1:=k
        Set Rng2 = ws.AutoFilter.Range
        Rng2.Copy
        Workbooks.Add (xlWBATWorksheet)
        With ActiveWorkbook
            .Worksheets(1).Cells(1).PasteSpecial xlPasteValues
            .SaveAs Filename:=sPath & sFilename, FileFormat:=xlCSV, local:=True
            .Close
        End With
        Application.CutCopyMode = False
    Next k

    Rng.AutoFilter field:=lCol

    Set Dict = Nothing
    Set Rng2 = Nothing: Set Rng = Nothing
    Set ws = Nothing
    Set wb = Nothing

End Sub
Rechercher des sujets similaires à "vba filtrer fonction liste"