Discussion :

[aziz1015]

Bonjour, j'ai un problème avec la copie d'une feuille après un filtre, j'ai utilisé ce programme des centaines de fois, il marche toujours bien, je ne sais pas pourquoi aujourd'hui, cela ne fonctionne pas !

Ici, le code que j'utilise pour faire le filtre et la copie dans un autre onglet :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
38
39
40
41
42
43
 
 
Sub Test1211()
 
Dim WsSOurce As Worksheet, filtre As Workbook, WsCible As Worksheet
Dim Deb As String, Fin As String
Set WsSOurce = ThisWorkbook.Sheets("Feuil1")
On Error Resume Next: WsSOurce.ShowAllData: On Error GoTo 0
Application.ScreenUpdating = False
Set WsCible = ThisWorkbook.Sheets.Add(After:=WsSOurce)
        Deb = ">" & Year(Date) - 1 & "/12/31"
        Fin = "<" & Format(Date, "yyyy/mm/01")
        WsCible.Name = "tarifé qsdqsd " & Year(Date)
        Set filtre = Workbooks.Add
        filtre.Sheets(1).Range("A1") = "Risque"
        filtre.Sheets(1).Range("B1") = "Risque"
        filtre.Sheets(1).Range("C1") = "Date de fin"
        filtre.Sheets(1).Range("D1") = "Date de fin"
'        filtre.Sheets(1).Range("D1") = "Statut_Etude"
'        filtre.Sheets(1).Range("E1") = "Statut_Etude"
 
        filtre.Sheets(1).Range("A2") = "=SANTE"
        filtre.Sheets(1).Range("B2") = "=PREVOYANCE"
        filtre.Sheets(1).Range("C2") = Deb
        filtre.Sheets(1).Range("D2") = Fin
'        filtre.Sheets(1).Range("D2") = ">2"
'        filtre.Sheets(1).Range("E2") = "<7"
        FiltreActif WsSOurce.UsedRange, filtre.Sheets(1).UsedRange, WsCible.Range("A1")
        filtre.Close False
        Set filtre = Nothing
        Application.ScreenUpdating = True
End Sub
Function FiltreActif(RangeSource As Range, CriterRange As Range, CopyRange As Range, Optional Unique As Boolean = True) As Boolean
FiltreActif = False
On Error Resume Next
 RangeSource.AdvancedFilter Action:= _
        xlFilterCopy, CriteriaRange:=CriterRange _
        , CopyToRange:=CopyRange, Unique:=Unique
        DoEvents
        If Err = 0 Then FiltreActif = True
        'MsgBox Err.Description
        On Error GoTo 0
End Function

Comme vous pouvez le constater sur l'imprim écran, la copie ne se fait que sur la première ligne de l'onglet, les autres données ne sont pas copiées, je ne comprends pas pourquoi !

:

En vous remerciant d'avance pour votre aide

[Daniel.C]

Bonjour,

Enlève les "On Error" voir si ça fait une différence.

[aziz1015]

Merci pour votre réponse Daniel.C,

J'ai enlevé les "On Error" mais cela n'a rien changé, je ne comprends vraiment pas pourquoi il ne copie que la première ligne de la feuille ou bien le filtre n'est pas fait ?

Tout me semble correct pourtant, je n'arrive pas à avancer depuis ce matin

[Daniel.C]

Quelle est l'étendue de la plage de critères ? Remplace la fonction par :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Function FiltreActif(RangeSource As Range, CriterRange As Range, CopyRange As Range, Optional Unique As Boolean = True) As Boolean
FiltreActif = False
On Error Resume Next
 MsgBox = criteriarange.Address
 RangeSource.AdvancedFilter Action:= _
        xlFilterCopy, criteriarange:=CriterRange _
        , CopyToRange:=CopyRange, Unique:=Unique
        DoEvents
        If Err = 0 Then FiltreActif = True
        'MsgBox Err.Description
        On Error GoTo 0
End Function

[Philippe Tulliez]

Bonjour,
Sauf erreur de ma part, le problème provient de la plage RangeSource qui sans doute commence en A1 alors que d'après l'image devrait commencer en A2. En effet le filtre avancé d'excel doit avoir en ligne 1, les étiquettes de colonnes et ensuite les lignes de données.

[aziz1015]

Bonjour,
Sauf erreur de ma part, le problème provient de la plage RangeSource qui sans doute commence en A1 alors que d'après l'image devrait commencer en A2. En effet le filtre avancé d'excel doit avoir en ligne 1, les étiquettes de colonnes et ensuite les lignes de données.

J'ai aussi pensé que le problème venait de là, j'ai donc supprimé la première ligne comportant l'année ! Aussi en changeant la fonction comme l'a suggéré Daniel.C, j'ai compris d'où provenait l'erreur et le filtre se fait.

Ce qui me conduit à un autre problème, comment pourrais je faire correctement le filtre et la copie sans supprimer la première ligne ?

Aussi, je ne sais pas comment spécifier que le critère risque doit prendre en compte SANTE et PREVOYANCE, le filtre ne se fait pas lorsque je procède comme suit :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
 
 
       Set filtre = Workbooks.Add
        filtre.Sheets(1).Range("A1") = "Risque"
        filtre.Sheets(1).Range("B1") = "Risque"
 
        filtre.Sheets(1).Range("A2") = "SANTE"
        filtre.Sheets(1).Range("B2") = "PREVOYANCE"

Merci pour votre aide

[Daniel.C]

Oups. enlève le "=".