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 "
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
___________
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 |
Partager