Macro utilisant un filtre avancé

**messlinger** · 25/04/2018, 12h38

Bonjour à tous,

Je souhaite utiliser le code suivant pour :
1. filtrer du contenu dans un classeur avec comme critère la valeur d'une cellule dans un autre classeur
2. coller ce contenu dans un 3e classeur

J'utilise pour le moment le code ci-dessous. Tout fonctionne jusqu'à la ligne "

Code :

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

Workbooks(VarW2).Sheets(VarS2).Cells.ClearContents

" (ouverture des fichiers etc.).

J'ai l'impression que le code / le chemin ne sont pas reconnus. Est-ce que quelqu'un aurait un suggestion pour debugger / corriger le point ?

Merci d'avance,

Marc

___________

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
 
Dim AllData As String
Dim VendorFile As String
Dim BiddingTool As String
 
AllData = ActiveWorkbook.Path & "\results.xls"
VendorFile = ActiveWorkbook.Path & "\Vendor_Code_Data.xlsx" '->>>>> name to adapt'
 
 
 
Workbooks.Open (VendorFile)
Workbooks.Open (AllData)
 
'Advance filtering to copy paste'
 
Dim FilterRange As Range, Criteria As Range, TargetRange As Range
 
'Assign Workbook Variables
    VarW1 = AllData
    VarW2 = VendorFile
    If VarW1 = VarW2 Then VarW2 = Workbooks(3).Name
    If VarW2 = "" Then
        MsgBox "You must have your Target WorkBook Open."
        Exit Sub
    End If
 
'Assign WorkSheet Variables
 
    VarS1 = "results"
    VarS2 = "Vendor_Code_Data"
 
'Clear Target range of old Data
 
    Workbooks(VarW2).Sheets(VarS2).Cells.ClearContents
 
'Be sure you are in the proper book and sheet
 
    Workbooks(VarW1).Sheets(VarS1).Select
 
'Assign Date range to Advanced Filter Criteria cells
 
    Sheets("Summary").Range("C3").Value
 
'Set variables to specific Ranges
 
    Set FilterRange = Workbooks(VarW1).Sheets(VarS1).Range("A1").CurrentRegion
    Set Criteria = Workbooks(VarW1).Sheets("Summary").Range("C3").CurrentRegion
    Set TargetRange = Workbooks(VarW2).Sheets(VarS2).Range("A1")
 
'Do Advanced Filter using variables
 
    FilterRange.AdvancedFilter Action:=xlFilterCopy, _
        CopyToRange:=TargetRange, CriteriaRange:=Criteria
 
'Clear memory of variables
 
    Set FilterRange = Nothing
    Set Criteria = Nothing
 
End Sub

**Menhir** · 25/04/2018, 13h44

Le nom d'un objet Workbook ne contient pas le chemin puisqu'il ne désigne pas le fichier mais le classeur en mémoire.

Cela dit, il est plus judicieux d'utiliser des variable de type Workbook ou Worksheet pour désigner des classeurs ou des onglets plutôt que des variables String.

J'ai retravaillé ton code.
Je n'ai pas compris ce que fait If VarW1 = VarW2 Then VarW2 = Workbooks(3).Name. Ca me semble peu fiable d'appeler un classeur par son numéro.

Je n'ai pas non plus compris Sheets("Summary").Range("C3").Value. Cette ligne va certainement planter (un Value ne peut pas être une action en soi). Je pense que c'était un relicat de développement et je l'ai supprimée.

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
Dim AllData As String
Dim VendorFile As String
Dim FilterRange As Range, Criteria As Range, TargetRange As Range
Dim WB_Data As Workbook, WB_Vendor As Workbook
Dim WS1 As Worksheet, WS2 As Worksheet
 
AllData = "results.xls"
VendorFile = "Vendor_Code_Data.xlsx"     '->>>>> name to adapt'
 
Set WB_Vendor =Workbooks.Open (ActiveWorkbook.Path & "\" & VendorFile)
Set WB_Data = Workbooks.Open (ActiveWorkbook.Path & "\" & AllData)
 
If WB_Vendor Is Nothing Then
    MsgBox "You must have your Target WorkBook Open."
    Exit Sub
End If
 
If WB_Vendor.Name = WB_Data.Name Then Set WB_Vendor = Workbooks(3)
 
' ---- Assign WorkSheet Variables
Set WS1 = WB_Data.Worksheets("results")
Set WS2 = WB_Vendor.Worksheets("Vendor_Code_Data")
 
' ---- Clear Target range of old Data
WS2.UsedRange.ClearContents
 
' ---- Set variables to specific Ranges
 
Set FilterRange = WS1.Range("A1").CurrentRegion
Set Criteria = WS_Data.Worksheets("Summary").Range("C3").CurrentRegion
Set TargetRange = WS2.Range("A1")
 
' ---- Do Advanced Filter using variables
 
FilterRange.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=TargetRange, CriteriaRange:=Criteria
 
End Sub

[/QUOTE]

C'est du code tapé à l'arrache directement sur le forum et non testé. Il se peut qu'il y ait des détails à corriger.

**messlinger** · 25/04/2018, 14h24

Merci beaucoup Menhir.

Malheureusement j'ai toujours le message d'erreur suivant pour cette instruction : Set Criteria = WS_Data.Worksheets("Summary").Range("C3").CurrentRegion
Le message d'erreur affiche :" Erreur d'execution 424, objet non trouvé"

A la place de WS_Data, j'ai essayé WB_Data mais ça ne fonctionne pas non plus, le message d'erreur :"L'indice n'appartient pas à la sélection".

Merci encore d'avance pour ton aide,

Marc

**Menhir** · 25/04/2018, 15h12

Envoyé par messlinger

A la place de WS_Data, j'ai essayé WB_Data mais ça ne fonctionne pas non plus, le message d'erreur :"L'indice n'appartient pas à la sélection".

La seule explication qui me semble possible, c'est qu'il n'y a pas d'onglet "Summary" dans le classeur "results.xls".

**messlinger** · 25/04/2018, 16h34

Merci Menhir.
Vous avez raison il faut que j'appelle un 3e workbook dans lequel l'onglet summary est situé et dans lequel le critère de filtre est également situé.
J'essaie le code suivant qui bloque au niveau de Set WB_Bidding = Workbooks(ActiveWorkbook.Path & "\" & Bidding), le programme ne reconnait pas l'indice encore une fois. Ce WB là sera ouvert au moment auquel la macro tournera.

Avez-vous une idée de ce que je dois corriger sur cette instruction et du coup sur le critère de filtre ?

Merci encore pour votre aide.

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
Sub data_manipulation()
 
Dim AllData As String
Dim VendorFile As String
Dim Bidding As String
Dim FilterRange As Range, Criteria As Range, TargetRange As Range
Dim WB_Data As Workbook, WB_Vendor As Workbook, WB_Bidding As Workbook
Dim WS1 As Worksheet, WS2 As Worksheet
 
AllData = "results.xls"
VendorFile = "Vendor_Code_Data.xlsx"     '->>>>> name to adapt'
Bidding = "201804_Bidding.xlsm"
 
Set WB_Vendor = Workbooks.Open(ActiveWorkbook.Path & "\" & VendorFile)
Set WB_Data = Workbooks.Open(ActiveWorkbook.Path & "\" & AllData)
Set WB_Bidding = Workbooks(ActiveWorkbook.Path & "\" & Bidding)
 
If WB_Vendor Is Nothing Then
    MsgBox "You must have your Target WorkBook Open."
    Exit Sub
End If
 
If WB_Vendor.Name = WB_Data.Name Then Set WB_Vendor = Workbooks(3)
 
' ---- Assign WorkSheet Variables
Set WS1 = WB_Data.Worksheets("results")
Set WS2 = WB_Vendor.Worksheets("Vendor_Code_Data")
 
' ---- Clear Target range of old Data
WS2.UsedRange.ClearContents
 
' ---- Set variables to specific Ranges
 
Set FilterRange = WS1.Range("A1").CurrentRegion
Set Criteria = WB_Bidding.Worksheets("Summary").Range("C3").CurrentRegion
Set TargetRange = WS2.Range("A1")
 
' ---- Do Advanced Filter using variables
 
FilterRange.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=TargetRange, CriteriaRange:=Criteria
 
End Sub