Macro pour faire un filtre élaboré (n'extraire que certaines colonnes...choisies)

Sub Resultat()
Dim t$, P As Range, col As Range
t = Right([BA1], 1)
Feuil2.Cells.Clear 'RAZ
If t < "1" Or t > "5" Then Exit Sub
Set P = [AO:AY]
For Each col In Columns("A:AN")
  If Right(col.Cells(1), 1) = t Then Set P = Union(P, col)
Next
With Feuil2
  P.Copy .[A1]
  .[A:A].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  .Columns.AutoFit
  .Activate
End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)Dim pl As Range 'déclare la variable pl (PLage)
Dim c As String 'déclare la variable c (Critère)
Dim r As Range 'déclare la variable r (Recherche)
Dim pa As String 'déclare la variable pa (Première Adresse)
Dim dest As Range 'déclare la variable dest (cellule de DESTination)
Dim col As Byte 'déclare la variable col (COLonne)
Dim ld As Integer 'déclare la variable ld (Ligne du début)
Dim lf As Integer 'déclare la variable lf (Ligne de Fin)


If Target.Address <> "$BA$1" Then Exit Sub 'si le changement a lieu ailleurs qu'en BA1, sort de la procédure
Set pl = Range("A1:AY1") 'définit la plage pl
c = Right(Target.Value, 3) 'définit le critère c (les 3 derniers caractères de AB1)
Sheets("Résultats").Cells.ClearContents 'effaces les anciennes données de l'onglet "Résultats"
Set r = pl.Find(c, Range("AY1"), xlValues, xlPart) 'définit la recherche r (recherche le critère c dans la plage pl)
If Not r Is Nothing Then 'condition : si il existe au moins une occurrence trouvée
    pa = r.Address 'définit l'adresse de la première occurrence trouvée
    Do 'exécute
        col = r.Column 'définit la colonne col
        With Sheets("Résultats") 'prend en compte l'onglet "Résultats"
            'définit la cellule de destination dest
            Set dest = IIf(.Cells(1, 1).Value = "", .Cells(1, 1), .Cells(1, Application.Columns.Count).End(xlToLeft).Offset(0, 1))
        End With 'fin de la prise en compte de l'onglet "Résultats"
        r.Copy dest 'copie l'occurrence trouvée dans dest
        'si la dernière ligne éditée de la colonne col est la ligne 1, va à l'étiquette "suite"
        If Cells(Application.Rows.Count, col).End(xlUp).Row = 1 Then GoTo suite
        ld = IIf(r.Offset(1, 0) <> "", 2, r.End(xlDown).Row) 'définit la ligne du début ld
        lf = Cells(Application.Rows.Count, col).End(xlUp).Row 'définit la ligne de fin lf
        Range(Cells(ld, col), Cells(lf, col)).Copy dest.Offset(1, 0) 'copie les données et les colle en dessous de dest
suite: 'étiquette
        Set r = pl.FindNext(r) 'redéfinit la recherche r (occurrence suivante)
    'boucle tant qu'il existe de nouvelles occurrences ailleurs qu'en pa
    Loop While Not r Is Nothing And r.Address <> pa
End If 'fin de la conditikon
Range("AO1:AY1").Copy dest.Offset(0, 1) 'récupère les en-têtes de fin du tableau
Range(Cells(ld, 41), Cells(lf, 51)).Copy dest.Offset(1, 1) 'récupère les données de fin du tableau
End Sub