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

[Christian0258]

Re, Bonjour à tout le forum,

Me revoila, encore..., pour vous demander de l'aide au niveau de l'écriture d'une macro, pour un filtre élaboré, afin d'extraire vers une autre feuille certaines colonnes...

voir fichier joint.

Je vous remercie pour l'aide que vous m'apporter, et le dérangement occasionné.

Merci pour tout,
Bien à vous,
Christian

 

[job75]

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

Bonjour Christian,

Le filtre élaboré n'a rien à voir ici.

Si j'ai bien compris seule la donnée en BA1 sert de critère.

Et même seul son numéro à la fin est utile :

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

Fichier joint.

A+

 

[Robert]

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

Bonsoir Christian, bonsoir le forum,

En pièce jointe ton fichier modifié avec la macro événementielle Change. Change la trame en BA1 et la macro agit...
Le code :

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

Le Fichier :

[Édition]
Bonsoir Job on s'est croisé...

 

[Christian0258]

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

Re, le forum, job75, Robert,

Merci à vous, c'est parfaitement, parfait...

Encore merci.
Bien à vous,
Christian