Fonction filtre auto

Le 20/09/2012 à 15:15

Bonjour,

j'ai un fichier avec un filtre automatique

j'aimerais que lorsque je fais un tri par la colonne A un recapitulatif se fait en feuil2

Ci-joint une explication par un fichier exemple.

Merci d'avance

16filtre-auto.zip (22.46 Ko)

Le 23/09/2012 à 20:34

est-ce possible?

Le 23/09/2012 à 22:58

Bonsoir,

Ci-joint fichier à tester et à adapter à tes besoins.

Cordialement

Public Sub FiltreAuto()
'Jean-Eric
Dim sH_1 As Worksheet
Dim sH_2 As Worksheet
Dim Plage As Range

    Application.ScreenUpdating = False

    Set sH_1 = Worksheets(1)
    Set sH_2 = Worksheets(2)

    With sH_1
        Set Plage = .Range("A4").CurrentRegion
        Plage.AdvancedFilter Action:= _
                xlFilterCopy, CriteriaRange:=sH_1.Range("A1:A2"), _
                CopyToRange:=sH_2.Range("A1:E1"), Unique:=False
    End With

End Sub

23filtre-elabore-sur-autre-feuille.zip (11.43 Ko)

Le 25/09/2012 à 11:45

comment conserve le filtre auto sur la feuil1

Si je remets le filtre auto sur la feuil1 et que je fais la macro le filtre auto disparait

Le 26/09/2012 à 10:14

Bonjour,

Ci-joint code modifié

Option Explicit
Public Sub FiltreAuto()
'Jean-Eric
Dim sH_1 As Worksheet
Dim sH_2 As Worksheet
Dim Plage As Range

    Application.ScreenUpdating = False

    Set sH_1 = Worksheets(1)
    Set sH_2 = Worksheets(2)

    With sH_1
        Set Plage = .Range("A4").CurrentRegion
        Plage.AdvancedFilter Action:= _
                xlFilterCopy, CriteriaRange:=sH_1.Range("A1:A2"), _
                CopyToRange:=sH_2.Range("A1:E1"), Unique:=False
        Plage.AutoFilter
    End With

End Sub

Le 04/10/2012 à 08:55

Jean-Eric a écrit :

Bonjour,

Ci-joint code modifié

Option Explicit
Public Sub FiltreAuto()
'Jean-Eric
Dim sH_1 As Worksheet
Dim sH_2 As Worksheet
Dim Plage As Range

    Application.ScreenUpdating = False

    Set sH_1 = Worksheets(1)
    Set sH_2 = Worksheets(2)

    With sH_1
        Set Plage = .Range("A4").CurrentRegion
        Plage.AdvancedFilter Action:= _
                xlFilterCopy, CriteriaRange:=sH_1.Range("A1:A2"), _
                CopyToRange:=sH_2.Range("A1:E1"), Unique:=False
        Plage.AutoFilter
    End With

End Sub

Ce code marche, mais comment faire si il faut rajouter une colonne, j'ai fait un essai en intercalant une colonne entre D et E cela me fait une erreur, si je change le code en mettant "CopyToRange:=sH_2.Range("A1:F1"), Unique:=False"

cela ne marche pas comment faire?

Le 04/10/2012 à 09:26

Bonjour,

En réponse à Tiralarc, j'ai modifié le code en intégrant une variable "Dercolonne" dynamique.

Cela ne fonctionne pas. Un idée peut-être du problème, ou faudra-t-il coder en dur après l'insertion de nouvelles colonnes?

Merci par avance de aide.

Cdlt

Option Explicit
Public Sub FiltreAuto()
'Jean-Eric
Dim sH_1 As Worksheet
Dim sH_2 As Worksheet
Dim Plage As Range
Dim Dercolonne As Integer

    Application.ScreenUpdating = False

    Set sH_1 = Worksheets(1)
    Set sH_2 = Worksheets(2)

    With sH_1
        Set Plage = .Range("A4").CurrentRegion
        Dercolonne = Cells(4, Cells.Columns.Count).End(xlToLeft).Column
        'MsgBox Dercolonne
        Plage.AdvancedFilter Action:= _
                xlFilterCopy, CriteriaRange:=sH_1.Range("A1:A2"), _
                CopyToRange:=sH_2.Range(Cells(1, 1), Cells(1, Dercolonne)), Unique:=False
        Plage.AutoFilter
    End With

End Sub

21filtre-elabore-sur-autre-feuille.zip (15.83 Ko)

Le 04/10/2012 à 11:42

Dans mon tableau complet, il y a des informations jusqu'a la colonne S je ne souhaite pas forcement inserée des lignes mais que les informations soit rapportées jusqu'a la colonne S dans la feuille 2

Le 04/10/2012 à 11:54

Re,

Je te renvoie le fichier.

Un postulat : que les champs de colonnes de la ligne n°'4 soient documentés comme dans l'exemple fourni.

Cdlt

Option Explicit
Public Sub FiltreAuto()
'Jean-Eric
Dim sH_1 As Worksheet
Dim sH_2 As Worksheet
Dim Plage As Range

    Application.ScreenUpdating = False

    Set sH_1 = Worksheets(1)
    Set sH_2 = Worksheets(2)

    With sH_1
        Set Plage = .Range("A4").CurrentRegion
        Plage.AdvancedFilter Action:= _
                xlFilterCopy, CriteriaRange:=sH_1.Range("A1:A2"), _
                CopyToRange:=sH_2.Range("A1:S1"), Unique:=False
        Plage.AutoFilter
    End With

    sH_2.Range("A1").Select

    Application.ScreenUpdating = True

End Sub

Re,

Dans précédent post supprimer l'avant dernière ligne du code: