HI
I am consolidating data from different workbooks to a single sheet.
In the WSR Consolidation excel, in the ‘LIST’ sheet I have created a Name ‘CritList with filter details.
I am filtering multiple data rows.
I am getting an error
Run time error 1004 autofilter method of range class failed
Please find the code and sample file.
Regards,
Naveen N
I am consolidating data from different workbooks to a single sheet.
In the WSR Consolidation excel, in the ‘LIST’ sheet I have created a Name ‘CritList with filter details.
I am filtering multiple data rows.
I am getting an error
Run time error 1004 autofilter method of range class failed
Please find the code and sample file.
Code:
Option Explicit
Sub pro2007FileSearchA()
Dim varPath
Dim varFile
Dim varThatWorkbook
Dim varNbRowsIn
Dim varNbcolsIn
Dim varNbRowsDatabase
Dim vCrit As Variant
Dim wsO As Worksheet
Dim wsL As Worksheet
Dim rngCrit As Range
Dim rngOrders As Range
Dim pw As String
Dim rng As Range
pw = "2281430"
varPath = ThisWorkbook.Path & "\"
varFile = Dir(varPath & "WSR_Horizon*.xlsm")
ThisWorkbook.Activate
Range("A1").Select
Rows("2:" & Rows.Count).ClearContents
Set wsL = Worksheets("Lists")
Set rngCrit = wsL.Range("CritList")
vCrit = rngCrit.Value
Do While varFile <> ""
Application.DisplayAlerts = False
Workbooks.Open varPath & varFile
varThatWorkbook = ActiveWorkbook.Name
Set wsO = Worksheets("WSR-HZN")
wsO.Unprotect Password:=pw
Set rngOrders = wsO.Range("$A$1").CurrentRegion
rngOrders.AutoFilter _
Field:=1, _
Criteria1:=Application.Transpose(vCrit), _
Operator:=xlFilterValues
Set rng = Selection.Offset(1, 0).Resize(Rows.Count - 1, Columns.Count) _
.SpecialCells(xlCellTypeVisible)
rng.Copy
ThisWorkbook.Activate
Range("A1").Select
varNbRowsDatabase = Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row
ActiveCell.Offset(varNbRowsDatabase, 0).Select
Selection.PasteSpecial xlPasteValues
Application.CutCopyMode = False
Windows(varThatWorkbook).Activate
wsO.Protect Password:=pw
ActiveWorkbook.Close
varFile = Dir
Application.DisplayAlerts = True
Loop
ThisWorkbook.Activate
Range("A1").Select
ActiveWorkbook.Save
Workbooks("Release_Weekof_Dropdown.xlsx").Close SaveChanges:=False
End SubRegards,
Naveen N