1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37
   | Private Sub CommandButton_Click()
    Dim i as Integer
    Dim j As Integer
    Dim CheckBoxes() As MSForms.CheckBox
    Dim Critères() As Variant
    Dim PlageDonnées As Range
    Dim PlageFiltree As Range
    Dim FeuilleSource As Worksheet
    Dim FeuilleFiltree As Worksheet
 
    Set FeuilleSource = Sheets("Feuil1")
    Set FeuilleFiltree = Sheets("Feuil2")
    Set PlageFiltree = FeuilleFiltree.Range("A1")
    PlageFiltree.Cells.ClearContents
 
    'Création du tableau de critères
    j = 0
    For i = 1 To 14
        If Me.Controls("CheckBox" & i).Value = True Then
            j = j + 1
            ReDim Preserve CheckBoxes(1 To j)
            Set CheckBoxes(j) = Me.Controls("CheckBox" & i)
            ReDim Preserve Critères(1 To j, 1 To 2)
            Critères(j, 1) = FeuilleSource.Range("A1:AF1").Cells(1, i).Value
            Critères(j, 2) = "X"
        End If
    Next i
 
    'Filtrage des données avec une logique "Ou inclusif"
    Set PlageDonnées = FeuilleSource.Range("A1:AF" & FeuilleSource.Cells(Rows.Count, 1).End(xlUp).Row)
    PlageDonnées.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Critères, CopyToRange:=PlageFiltree
 
    'Suppression des filtres
    PlageDonnées.AutoFilter
 
    Unload Me
End Sub | 
Partager