Remplacer la liste de choix d'un array par une variable

Bonjour,

Je ne suis pas sûr de la justesse des termes employés dans ma demande...
Est-il possible d'utiliser une variable pour alimenter un array ?
Dans le cas où ce serait possible, j'ai fait pas mal d'essais, mais je n'ai pour l'instant pas trouvé la bonne syntaxe.
Je joins un fichier que j'ai réduit, mais qui est fonctionnel.

La partie concernée est celle-ci :

ActiveSheet.ListObjects("Tableau2").Range.AutoFilter Field:=4, Criteria1:=Array(NomSociete2), Operator:=xlFilterValues

Elle est sensée remplacer cette ligne :

ActiveSheet.ListObjects("Tableau2").Range.AutoFilter Field:=4, Criteria1:= _
                                                         Array("DEAL", "DREAL", "DRIEE", "DTAM", "DD(CS)PP", "DDPP", "DDCSPP", "OFB", "ET4", "ET3", "MNHN"), Operator:=xlFilterValues

Code complet :

Sub Filtre_Administration_2()
    'Filtre sur administrations
    Dim i As Integer
    Dim NomSociete As String, NomSociete2 As String

    Set WsL = Worksheets("Listes")
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
    For i = 2 To 9
        NomSociete = """" & WsL.Range("J" & i)  '& NomSociete '.Value
        NomSociete2 = NomSociete2 & NomSociete & """, "
    Next i
    NomSociete2 = Left(NomSociete2, Len(NomSociete2) - 2)

    'ActiveSheet.ListObjects("Tableau2").Range.AutoFilter Field:=4, Criteria1:= _
                                                         Array("DEAL", "DREAL", "DRIEE", "DTAM", "DD(CS)PP", "DDPP", "DDCSPP", "OFB", "ET4", "ET3", "MNHN"), Operator:=xlFilterValues
    MsgBox NomSociete2
    ActiveSheet.ListObjects("Tableau2").Range.AutoFilter Field:=4, Criteria1:=Array(NomSociete2), Operator:=xlFilterValues

    Application.Goto Range("F4"), True
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
End Sub

Merci d'avance pour les conseils et l'aide apportée.
Bonne journée

Dan

Bonjour,

proposition de correction

Sub Filtre_Administration_2()
    'Filtre sur administrations
    Dim i As Integer
    Dim NomSociete As String, NomSociete2 As String

    Set WsL = Worksheets("Listes")
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
    For i = 2 To 9
        NomSociete = NomSociete & WsL.Range("J" & i) & ","  '& NomSociete '.Value
    Next i
    NomSociete = Left(NomSociete, Len(NomSociete) - 1)

    'ActiveSheet.ListObjects("Tableau2").Range.AutoFilter Field:=4, Criteria1:= _
                                                         Array("DEAL", "DREAL", "DRIEE", "DTAM", "DD(CS)PP", "DDPP", "DDCSPP", "OFB", "ET4", "ET3", "MNHN"), Operator:=xlFilterValues
    MsgBox NomSociete
    ActiveSheet.ListObjects("Tableau2").Range.AutoFilter Field:=4, Criteria1:=Split(NomSociete, ","), Operator:=xlFilterValues

    Application.Goto Range("F4"), True
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
End Sub

Bonjour,

Pouvez-vous essayer ceci :

    dim arrSociete2 as variant
'code
    arrSociete2 = application.transpose(WsL.Range("J2:J9"))
    ActiveSheet.ListObjects("Tableau2").Range.AutoFilter Field:=4, Criteria1:=arrSociete2, Operator:=xlFilterValues

Cdlt,

Bonjour,

Merci beaucoup à vous 2 pour vos réponses rapides et qui fonctionnent très bien.
Je m'embêtais à ajouter des guillemets autours des différentes valeurs pour rien, puisque non nécessaires.

La proposition de 3GB est sympa et évite la boucle et les manipulations d'ajout de virgules entre les valeurs, puis du retrait de la dernière.

Encore merci à vous 2 et merci au forum d'Excel-Pratique.

Bon am

Dan