Macro VB Excel filtre avancé= KO !

**toto92** · 07/07/2013, 22h26

bonjour

Je suis en train de creer un macro VB pour creer :

1) Sauvetage d'un fichier "Report_on_Critical_Fields.xls" en "Report_on_Critical_Fields.xlsx" ( c'est un fichier DATA avec 1 onglet "CI Changes")

2) Ouvrir un fichier "Liste des techniciens.xlsx" ( il y a 2 onglets "NDG" et "HNDG" ) ( c'est un fichier CRITERES)

3 ) Ré-Ouvrir "Report_on_Critical_Fields.xlsx" + Creation de 2 onglets "DataNDG" et "DataHNDG" ( Rappel : i y a deja 1 onglet "CI Changes" )

4) Dans ce fichier "Report_on_Critical_Fields.xlsx" : Creer un filtre avancé pour filtrer les données de l'onglet "CI Changes" vers "DataNDG" ( à partir de l'onglet "NDG" du fichier "Liste des techniciens.xlsx")

5) Dans ce fichier "Report_on_Critical_Fields.xlsx" :Creer un filtre avancé pour filtrer les données de l'onglet "CI Changes" vers "DataHNDG" ( à partir de l'onglet "HNDG" du fichier "Liste des techniciens.xlsx")

Ca ne marche pas ! code erreur = 1004 ! le macro s'arrete dans la "zone qui coince !" ( Voir mon fichier "Traitement_Report_on_Critical_Fields.xlsm" )

Je suis sous Windows 7 x32 bits + Excel 2010

ci joint 3 fichiers dont 1 "Traitement_Report_on_Critical_Fields.zip"
En fait c'est un fichier XLSM que j'ai du zipper car votre site ne semble pas accepter les XLSM

Merci & Bonne soirée !

**Philippe Tulliez** · 07/07/2013, 22h46

Bonsoir,

Ca ne marche pas ! code erreur = 1004 ! le macro s'arrete dans la "zone qui coince !" ( Voir mon fichier "Traitement_Report_on_Critical_Fields.xlsm" )

Il serait intéressant d'afficher le code VBA utilisé avec les commentaires nécessaires à sa compréhension et indiquer le n° de ligne où a lieu l'erreur.

Invité · 08/07/2013, 10h43

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
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
Sub Macro2()
Dim Wb As Workbook
Dim RonCriFilds As Workbook
Dim LstThec As Workbook
Set Wb = ActiveWorkbook
'  Set RonCriFilds = Workbooks.Open(Filename:= _
'        "D:\Tests Excel\Report_on_Critical_Fields.xls")
 Set RonCriFilds = Workbooks.Open(Filename:= _
       Wb.Path & "\Report_on_Critical_Fields.xls")
 
       RonCriFilds.Sheets("CI changes").Select
    RonCriFilds.Sheets("CI changes").Rows("1:1").Delete Shift:=xlUp
     RonCriFilds.Sheets("CI changes").Columns("A:A").Delete Shift:=xlToLeft
    RonCriFilds.Sheets("CI changes").Cells.Columns.AutoFit
    With RonCriFilds.Application.ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
    End With
    RonCriFilds.Application.ActiveWindow.FreezePanes = True
    RonCriFilds.Sheets("People changes").Select
      RonCriFilds.Sheets("People changes").Rows("1:1").Delete Shift:=xlUp
    RonCriFilds.Sheets("People changes").Columns("A:A").Delete Shift:=xlToLeft
    RonCriFilds.Sheets("People changes").Cells.Columns.AutoFit
    With RonCriFilds.Application.ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
    End With
    RonCriFilds.Application.ActiveWindow.FreezePanes = True
    RonCriFilds.Sheets("CI changes").Select
    RonCriFilds.Application.ActiveWindow.SmallScroll Down:=-15
'    RonCriFilds.Sheets("CI changes").Range("A1").Select
'    RonCriFilds.SaveAs Filename:= _
'        "D:\Tests Excel\Report_on_Critical_Fields.xlsx", _
'        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
 RonCriFilds.Application.DisplayAlerts = False
 RonCriFilds.SaveAs Filename:= _
        Wb.Path & "\Report_on_Critical_Fields.xlsx", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
 RonCriFilds.Application.DisplayAlerts = True
'Set LstThec =Workbooks.Open( Filename:= _
'        "D:\Tests Excel\Liste des techniciens.xlsx")
'    Sheets("NDG").Select
'    Windows("Report_on_Critical_Fields.xlsx").Activate
 
Set LstThec = Workbooks.Open(Filename:= _
        Wb.Path & "\Liste des techniciens.xlsx")
 
    LstThec.Sheets("NDG").Select
   RonCriFilds.Activate
    '
    RonCriFilds.Sheets.Add After:=Sheets(RonCriFilds.Sheets.Count)
    RonCriFilds.Sheets("Feuil1").Name = "DataNDG"
 
    '
  RonCriFilds.Sheets.Add After:=Sheets(RonCriFilds.Sheets.Count)
    RonCriFilds.Sheets("Feuil2").Name = "DataHNDG"
    '
    ' debut de la zone qui coince !!
    '
    RonCriFilds.Sheets("DataNDG").Select
     RonCriFilds.Sheets("DataNDG").Range("A1").Select
    FiltreActif RonCriFilds.Sheets("CI changes").UsedRange, LstThec.Sheets("NDG").UsedRange, RonCriFilds.Sheets("DataNDG").Range("A1"), False
'    Sheets("CI changes").Cells.AdvancedFilter Action:=xlFilterCopy, _
'    CriteriaRange:=Workbooks("Liste des techniciens.xlsx").Sheets("NDG").Range("A1:A10"), _
'    CopyToRange:=Range("DataNDG"), Unique:=False
    RonCriFilds.Sheets("DataHNDG").Select
    RonCriFilds.Sheets("DataHNDG").Range("A1").Select
     FiltreActif RonCriFilds.Sheets("CI changes").UsedRange, LstThec.Sheets("HNDG").UsedRange, RonCriFilds.Sheets("DataHNDG").Range("A1"), False
'    Sheets("CI changes").Cells.AdvancedFilter Action:=xlFilterCopy, _
'    CriteriaRange:=Workbooks("Liste des techniciens.xlsx").Sheets("HNDG").Range("A1:A9"), _
'    CopyToRange:=Range("DataHNDG"), Unique:=False
'    ActiveWorkbook.SaveAs Filename:= _
'        "D:\Tests Excel\Report_on_Critical_Fields.xlsx", _
'        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
RonCriFilds.Application.DisplayAlerts = False
RonCriFilds.SaveAs Filename:= _
        Wb.Path & "\Report_on_Critical_Fields.xlsx", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
 RonCriFilds.Application.DisplayAlerts = True
RonCriFilds.Close False
LstThec.Close False
Set RonCriFilds = Nothing
Set LstThec = Nothing
Set Wb = Nothing
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
        On Error GoTo 0
End Function

**toto92** · 09/07/2013, 09h20

c'est bon !

Merci beaucoup !

**toto92** · 12/07/2013, 09h30

Apres ameliorations ( ajout d'un filtre avancé avec exclusion) et tests : ca ne marchait plus j'ai du remplacer UserRange par Range("A1:A1x") ca allait et puis ca ne marchait plus du tout meme en faisant marche arriere ( c'est à dire copier/coller à partir de votre code ) ! je ne comprends plus ! voulez vous bien que je soumets mes 3 fichiers à votre oeil expert ? ( note : www.developpez.net refuse les fichiers xlsm alors je l'ai zippé )
merci

Invité · 12/07/2013, 10h38

bonjour,
ton fichier Report_on_Critical_Fields.xls est un XLS

**toto92** · 12/07/2013, 10h46

oui .. je cherche a creer à partir de ce xls ( qui contient 2 onglets )
un xlsx ( avec 2 onglets + 3 onglets supplementaires )
je ne comprends pas tres bien car mon code ne s'est pas planté .. il est allé jusqu'au bout et comme resultat : dans le xlsx : j'ai les 2 premiers onglets ( = okay ) mais et les 3 derniers onglets = vide

Invité · 12/07/2013, 12h09

comme je travail sauvant sur des automate placer sur un serveur, il n'y a personne pour cliquer sur Ok si apparait un message d'erreur.
d’où le On Error Resume Next et le If Err = 0 Then FiltreActif = True

Code :

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

1
2
3
4
5
6
7
8
9
10
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
        On Error GoTo 0
End Function

Code :

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

If FiltreActif(RonCriFilds.Sheets("CI changes").UsedRange, LstTech.Sheets("HNDG").UsedRange, RonCriFilds.Sheets("DataHNDG").Range("A1"), False) = False Then MsgBox "Err"

maintenant tu peux enregistre en XLSX ton fichier avant tout traitement et plus d'erreur.

**Philippe Tulliez** · 12/07/2013, 12h18

Bonjour,
Je ne sais pas si j'ai tout suivi mais le problème que tu décris avec les fichiers xls et xlsx vient du fait que tu sauves un ficher xls sous xlsx mais que le nombre de lignes et de colonnes est toujours de 65536 et 255 tant que tu ne l'as pas fermé et réouvert.
Fait le test manuellement, tu verras

Invité · 12/07/2013, 12h31

Code :

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

1
2
Set RonCriFilds = Workbooks.Open(Filename:= _
    Wb.Path & "\Report_on_Critical_Fields.xls")

il ouvre un XLS et place plus de valeurs qu'il ne peut en contenir et c'est après qu'il sauve en XLSX

Philippe Tulliez,ta remarque est est bonne mais il doit sauvegarder en XLSX avant le traitement.

**Philippe Tulliez** · 12/07/2013, 12h46

Bonjour Robert,

Oui, j'ai juste regardé son explication dans son premier post décrivant en point 1 qu'il sauvait le xls sous xlsx

1) Sauvetage d'un fichier "Report_on_Critical_Fields.xls" en "Report_on_Critical_Fields.xlsx" ( c'est un fichier DATA avec 1 onglet "CI Changes"

J'ai rencontré ce problème il y a quelques temps en sauvant manuellement un fichier version 2003 en version 2010 et je me suis retrouvé avec le même nombre de lignes et colonnes. J'ai donc dû fermer le fichier nouvellement sauvé et l'ouvrir à nouveau pour profiter pleinement des lignes et colonnes de la version 2010.

**toto92** · 12/07/2013, 15h57

j'ai ajouté juste apres le sauvetage de \Report_on_Critical_Fields.xlsx :

Code :

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

1
2
3
Set RonCriFilds = Workbooks.Open(Filename:= _
    Wb.Path & "\Report_on_Critical_Fields.xlsx")
    'MsgBox " Wb.Path = " & Wb.Path

ca semble marcher mieux mais je n'arrive pas à faire remplir correctement l'onglet "DataAVERIFIER" à partir de l'onglet "A_EXCLURE" qui contient des "<>" ( = different de .. )

Invité · 12/07/2013, 16h29

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
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
' soluce proposée par www.developpez.net
'
Sub Macro2()
Dim Wb As Workbook
Dim RonCriFilds As Workbook
Dim LstTech As Workbook
Set Wb = ActiveWorkbook
'
Set RonCriFilds = Workbooks.Open(Filename:= _
    Wb.Path & "\Report_on_Critical_Fields.xls")
    'MsgBox " Wb.Path = " & Wb.Path
    SaveClasseur RonCriFilds, Wb.Path & "\Report_on_Critical_Fields.xlsX"
    RonCriFilds.Close False
    Set RonCriFilds = Workbooks.Open(Filename:= _
    Wb.Path & "\Report_on_Critical_Fields.xlsx")
    MieEnform RonCriFilds.Sheets("CI changes")
    MieEnform RonCriFilds.Sheets("People changes")
 
    RonCriFilds.Sheets("CI changes").Application.ActiveWindow.SmallScroll Down:=-15
'
 
'
 
'
Set LstTech = Workbooks.Open(Filename:= _
    Wb.Path & "\Liste_des_techniciens.xlsx")
 
    RonCriFilds.Sheets.Add After:=Sheets(RonCriFilds.Sheets.Count)
    RonCriFilds.Sheets(RonCriFilds.Sheets.Count).Name = "DataNDG"
    '
    RonCriFilds.Sheets.Add After:=Sheets(RonCriFilds.Sheets.Count)
    RonCriFilds.Sheets(RonCriFilds.Sheets.Count).Name = "DataHNDG"
    '
    '
    RonCriFilds.Sheets.Add After:=Sheets(RonCriFilds.Sheets.Count)
    RonCriFilds.Sheets(RonCriFilds.Sheets.Count).Name = "DataAVERIFIER"
    '
    ' Si UsedRange ne marche pas ==> Remplacer par Range("A1:A12") pour NDG
    '
 
    FiltreActif RonCriFilds.Sheets("CI changes").UsedRange, LstTech.Sheets("NDG").Range("A1:A12"), RonCriFilds.Sheets("DataNDG").Range("A1"), False
 
    RonCriFilds.Sheets("DataNDG").Columns.AutoFit
    With RonCriFilds.Sheets("DataNDG").Application.ActiveWindow
       .SplitColumn = 0
        .SplitRow = 1
    End With
    RonCriFilds.Sheets("DataNDG").Application.ActiveWindow.FreezePanes = True
 
    ' Si UsedRange ne marche pas ==> Remplacer par Range("A1:A11") pour HNDG
 
    FiltreActif RonCriFilds.Sheets("CI changes").UsedRange, LstTech.Sheets("HNDG").Range("A1:A11"), RonCriFilds.Sheets("DataHNDG").Range("A1"), False
    RonCriFilds.Sheets("DataHNDG").Cells.Columns.AutoFit
    With RonCriFilds.Sheets("DataHNDG").Application.ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
    End With
    RonCriFilds.Sheets("DataHNDG").Application.ActiveWindow.FreezePanes = True
 
   ' Si UsedRange ne marche pas ==> Remplacer par Range("A1:U2") pour A_EXCLURE
   ' Pour pouvoir exclure il faut coder les criteres en colonnes et non pas en lignes !!!
   '
 
   FiltreActif RonCriFilds.Sheets("CI changes").UsedRange, LstTech.Sheets("A_Exclure").UsedRange, RonCriFilds.Sheets("DataAVERIFIER").Range("A1"), False
 
   RonCriFilds.Sheets("DataAVERIFIER").Cells.Columns.AutoFit
   With RonCriFilds.Sheets("DataAVERIFIER").Application.ActiveWindow
       .SplitColumn = 0
       .SplitRow = 1
   End With
   RonCriFilds.Sheets("DataAVERIFIER").Application.ActiveWindow.FreezePanes = True
 
   RonCriFilds.Save
   RonCriFilds.Close False
   LstTech.Close False
Set RonCriFilds = Nothing
Set LstTech = Nothing
Set Wb = Nothing
MsgBox " C'est fini ! "
End Sub
Sub MieEnform(Feuille As Worksheet)
 
    Feuille.Select
    Feuille.Rows("1:1").Delete Shift:=xlUp
    Feuille.Columns("A:A").Delete Shift:=xlToLeft
    Feuille.Cells.Columns.AutoFit
    With Feuille.Application.ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
    End With
    Feuille.Application.ActiveWindow.FreezePanes = True
    Feuille.Range("A1").Select
End Sub
Sub SaveClasseur(Wb As Workbook, FichierXls As String)
Wb.Application.DisplayAlerts = False
    Wb.SaveAs Filename:= _
    FichierXls, _
    FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    Wb.Application.DisplayAlerts = 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
        On Error GoTo 0
End Function

**toto92** · 13/07/2013, 08h23

ouais !
il reste encore 1 chose à regler :
comment faire pour filtre avancé pour copier tous sauf ceux listés dans onglet "A_Exclure" ( le caractere "<>" semble ne pas fonctionner en VBA ) et les copier dans obglet "DataAVERIFIER"
les criteres à exclure ( dans onglet "A-Exclure" ) doivent-ils etre en colonne ( A1:A24) ou en ligne ( A1:X2) ?
Merci et bon WE

**toto92** · 06/08/2014, 17h53

Envoyé par rdurupt

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
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
' soluce proposée par www.developpez.net
'
Sub Macro2()
Dim Wb As Workbook
Dim RonCriFilds As Workbook
Dim LstTech As Workbook
Set Wb = ActiveWorkbook
'
Set RonCriFilds = Workbooks.Open(Filename:= _
    Wb.Path & "\Report_on_Critical_Fields.xls")
    'MsgBox " Wb.Path = " & Wb.Path
    SaveClasseur RonCriFilds, Wb.Path & "\Report_on_Critical_Fields.xlsX"
    RonCriFilds.Close False
    Set RonCriFilds = Workbooks.Open(Filename:= _
    Wb.Path & "\Report_on_Critical_Fields.xlsx")
    MieEnform RonCriFilds.Sheets("CI changes")
    MieEnform RonCriFilds.Sheets("People changes")
 
    RonCriFilds.Sheets("CI changes").Application.ActiveWindow.SmallScroll Down:=-15
'
 
'
 
'
Set LstTech = Workbooks.Open(Filename:= _
    Wb.Path & "\Liste_des_techniciens.xlsx")
 
    RonCriFilds.Sheets.Add After:=Sheets(RonCriFilds.Sheets.Count)
    RonCriFilds.Sheets(RonCriFilds.Sheets.Count).Name = "DataNDG"
    '
    RonCriFilds.Sheets.Add After:=Sheets(RonCriFilds.Sheets.Count)
    RonCriFilds.Sheets(RonCriFilds.Sheets.Count).Name = "DataHNDG"
    '
    '
    RonCriFilds.Sheets.Add After:=Sheets(RonCriFilds.Sheets.Count)
    RonCriFilds.Sheets(RonCriFilds.Sheets.Count).Name = "DataAVERIFIER"
    '
    ' Si UsedRange ne marche pas ==> Remplacer par Range("A1:A12") pour NDG
    '
 
    FiltreActif RonCriFilds.Sheets("CI changes").UsedRange, LstTech.Sheets("NDG").Range("A1:A12"), RonCriFilds.Sheets("DataNDG").Range("A1"), False
 
    RonCriFilds.Sheets("DataNDG").Columns.AutoFit
    With RonCriFilds.Sheets("DataNDG").Application.ActiveWindow
       .SplitColumn = 0
        .SplitRow = 1
    End With
    RonCriFilds.Sheets("DataNDG").Application.ActiveWindow.FreezePanes = True
 
    ' Si UsedRange ne marche pas ==> Remplacer par Range("A1:A11") pour HNDG
 
    FiltreActif RonCriFilds.Sheets("CI changes").UsedRange, LstTech.Sheets("HNDG").Range("A1:A11"), RonCriFilds.Sheets("DataHNDG").Range("A1"), False
    RonCriFilds.Sheets("DataHNDG").Cells.Columns.AutoFit
    With RonCriFilds.Sheets("DataHNDG").Application.ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
    End With
    RonCriFilds.Sheets("DataHNDG").Application.ActiveWindow.FreezePanes = True
 
   ' Si UsedRange ne marche pas ==> Remplacer par Range("A1:U2") pour A_EXCLURE
   ' Pour pouvoir exclure il faut coder les criteres en colonnes et non pas en lignes !!!
   '
 
   FiltreActif RonCriFilds.Sheets("CI changes").UsedRange, LstTech.Sheets("A_Exclure").UsedRange, RonCriFilds.Sheets("DataAVERIFIER").Range("A1"), False
 
   RonCriFilds.Sheets("DataAVERIFIER").Cells.Columns.AutoFit
   With RonCriFilds.Sheets("DataAVERIFIER").Application.ActiveWindow
       .SplitColumn = 0
       .SplitRow = 1
   End With
   RonCriFilds.Sheets("DataAVERIFIER").Application.ActiveWindow.FreezePanes = True
 
   RonCriFilds.Save
   RonCriFilds.Close False
   LstTech.Close False
Set RonCriFilds = Nothing
Set LstTech = Nothing
Set Wb = Nothing
MsgBox " C'est fini ! "
End Sub
Sub MieEnform(Feuille As Worksheet)
 
    Feuille.Select
    Feuille.Rows("1:1").Delete Shift:=xlUp
    Feuille.Columns("A:A").Delete Shift:=xlToLeft
    Feuille.Cells.Columns.AutoFit
    With Feuille.Application.ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
    End With
    Feuille.Application.ActiveWindow.FreezePanes = True
    Feuille.Range("A1").Select
End Sub
Sub SaveClasseur(Wb As Workbook, FichierXls As String)
Wb.Application.DisplayAlerts = False
    Wb.SaveAs Filename:= _
    FichierXls, _
    FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    Wb.Application.DisplayAlerts = 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
        On Error GoTo 0
End Function

Je viens de m'apercevoir ( 1 an apres ! ) que XlFilterCopy oublie de coller certaines valeurs ( les dates comme "21/12/2012 02:44:23" au format personnalisée ) ===> ?????

**Philippe Tulliez** · 06/08/2014, 18h05

Bonjour,
Quels critères utilises-tu, les étiquettes de colonnes ou les critères calculés ?

**toto92** · 07/08/2014, 08h36

Code :

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

1
2
3
4
5
6
 
 FiltreActif RonCriFilds.Sheets("CI changes").Range("B5:Y" & Derniere), LstTech.Sheets("NDG").Range("A1:A16"), RonCriFilds.Sheets("DataNDG").Range("A1"), False
   '
 FiltreActif RonCriFilds.Sheets("CI changes").Range("B5:Y" & Derniere), LstTech.Sheets("HNDG").Range("A1:A13"), RonCriFilds.Sheets("DataHNDG").Range("A1"), False
   '
   FiltreActif RonCriFilds.Sheets("CI changes").Range("B5:Y" & Derniere), LstTech.Sheets("A_Exclure").Range("A1:Z2"), RonCriFilds.Sheets("DataAVERIFIER").Range("A1"), False

et plus loin ...

Code :

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

1
2
3
4
5
6
7
8
9
10
11
 
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
        On Error GoTo 0
End Function

**Philippe Tulliez** · 07/08/2014, 08h48

Bonjour,
Ce qui m'intéressait surtout, c'est la zone des critères mais en regardant ton code, je vois que tu utilises les critères en utilisant les étiquettes de colonnes.

Je viens de m'apercevoir ( 1 an apres ! ) que XlFilterCopy oublie de coller certaines valeurs ( les dates comme "21/12/2012 02:44:23" au format personnalisée ) ===> ?????

Je n'ai pas bien compris ce qui n'est pas exporté dû au format personnalisé. Est-ce une date qui n'est pas exportée ?
Si tu as mis le 21/12/2012 comme critère, c'est normal car pour excel cela revient à 21/12/2012 00:00:00 ce qui n'est pas la même chose que la même date à 2h44:23'
Donc la solution serait d'utiliser les critères calculés en comparant la valeur entière des dates
Si tu ne connais pas, je te conseille la lecture de Les filtres avancés ou élaborés dans Excel

**toto92** · 07/08/2014, 11h27

Je cherche à copier/coller toutes les colonnes
je vous joints 3 fichiers :

Liste_des_techniciens.xlsx
Report on Critical Fields.xlsx
Traitement_Report_on_Critical_Fields V2.zip ( contient le fichier xlsm qui cree 3 onglets DataNDG + DataHNDG + DataAVERIFIER + en fonction de MODIFY USER ( col H ) selectionne les lignes et les copie dans les 3 onglets nouvellement crées

Apres execution du macro : on obtient alors un nouveau fichier : Report on Critical Fields_2014_08_07_FRANCE_SPAIN.xlsx

Noter dans le nouveau fichier :

pour le Serial Number = 1LJ6XN1 ( col J dans onglet CI changes ) : on ne retrouve pas le Submit Date ( = 25/03/2013 07:16:39 ) dans l'onglet DataNDG (col S = vide )
pour le Serial Number = 30FZ3Q1 ( col J dans onglet CI changes ) : on ne retrouve pas le Submit Date ( = 03/07/2013 02:39:47 ) dans l'onglet DataHNDG (col S = vide )
pour le Serial Number = JFFGQ3J ( col J dans onglet CI changes ) : on retrouve bien le Submit Date ( = 03/07/2013 02:39:47 ) dans l'onglet DataAVERIFIER (col O et Q ) mais pourquoi les copier aussi d'autres colonnes S , U et W ??)
etc...

**Philippe Tulliez** · 07/08/2014, 12h08

Bonjour,
Tu ne réponds pas à ma question et je n'ai pas l'intention de tester tes classeurs car je sais que la piste que je te donne est la bonne.
Il est important de savoir quel est le critère utilisé.
Si c'est une date que tu places en critère il considère que c'est cette date à 0 heure et forcément si une ligne contient une date avec une heure autre que 0 heure elle ne sera pas exportée.
Je t'ai donc suggéré de passer par le filtre calculé. As-tu essayé ?
Fais un test et tu verras que cela passera.
Explication
Nous avons une plage de cellules A1:M101 et qu'en colonne I, j'ai des dates introduites simplement jj/mm/aa visualisées 15/10/2001 00:00 à l'aide du format personnalisé adéquat et avec comme en tête de colonne Date Entrée.
Nous mettons dans la zone des critères $P$1:$P$2 de la même feuille en P1, Date Entrée et en P2, la date cherchée (dans notre exemple 15/10/2001 peu importe son format.
Nous appliquons un filtre élaboré avec filtre sur place mais le résultat sera le même avec une exportation et nous obtenons quatre lignes répondant aux critères.

Maintenant nous modifions la valeur d'une des cellules ayant comme date le 15/10/2001 et nous ajoutons 14:00
Nous relançons le filtre et nous n'obtenons plus que trois lignes. Normal

Filtre avec critères calculés
En P1, nous mettons par exemple formula (l'étiquette de la zone des critères doit avoir un nom différents qu'une des étiquettes de colonne de la zone des données) et en P2, la formule suivante

Code :

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