Getting data from multiple workbooks (+200) using Index & Match in VBA (?)

[M2909]

Hi all,

This is my first post on this forum, you guys already helped me a lot by answering other people's questions.
But now i can't really find a solution.

We have on a yearly basis, a total of 208 workbooks (1 for each hal, p. week)
now i want to extract a certain field of data to a masterfile.

I have written below Index&Match foruma and this works, but it is very time consuming becaus each formula has to be adjusted to the exact path (manually)

=INDEX(PathToFile.xlsx]*sheetname*'!$B$7:$N$36;MATCH(BP$1;'PathToFile.xlsx]*sheetname*'!$A$7:$A$36;0);MATCH($A390;'PathToFile.xlsx]*Sheetname*'!$B$5:$N$5;0))

So now i'm trying my luck in VBA, it's all pretty new to me (bought a book this weekend) and by digging into the macros which i find on the net i'm learning every day.
Below Macro i've written based on information i found on the net:

it kind of works, but it just pastes the Range into my masterfile in a following order, without checking wether i'ts in the right row (which refers to the exact date)

Hope you can help! Thanks!

Public Sub test()
'DECLARE AND SET VARIABLES
Dim wbk As Workbook
Dim Filename As String
Dim Path As String


Application.ScreenUpdating = False


Path = "W:\Path"
Filename = Dir(Path & "*.xlsx")
'--------------------------------------------
'OPEN EXCEL FILES
Do While Len(Filename) > 0 'IF NEXT FILE EXISTS THEN
Set wbk = Workbooks.Open(Path & Filename)
Sheets("Weekoverzicht").Select
ActiveSheet.Unprotect Password:="******"
Range("B7:z29").SpecialCells(xlCellTypeVisible).Copy
Sheet1.Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
ActiveSheet.protect Password:="******"


'Prevents question for copy clipboard
Application.CutCopyMode = False


wbk.Close True
Filename = Dir
Loop
End Sub

 

[M2909]

Hi Steve,

It's not what i had in mind but i managed a workaround.

No i have another thing,
I want to paste the data in Column Z, Row 2.
However, for some reason the data is pasted in Z129.

My other 3 Modules are working perfectly fine, and i don't see the difference between them.

NOT WORKING:
ThisWorkbook.Sheets("Sheet1").Range("Z2:AR2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents

'--------------------------------------------
'OPEN EXCEL FILES
Do While Len(Filename) > 0 'IF NEXT FILE EXISTS THEN
Set wbk = Workbooks.Open(Path & Filename)
Sheets("Weekoverzicht").Select
'Unprotect sheet
ActiveSheet.Unprotect Password:="*****"
'Copy data from source
Range("B5:h23").SpecialCells(xlCellTypeVisible).Copy
'Paste data in Sheet 1
ThisWorkbook.Sheets("Sheet1").Range("Z" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
'Protect sheet again
ActiveSheet.protect Password:="*****"


'Prevents question for copy clipboard
Application.CutCopyMode = False


'wbk.Close = don't save
wbk.Close False
Filename = Dir
Loop


WORKING:
ThisWorkbook.Sheets("Sheet1").Range("AS2:BK2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents

'--------------------------------------------
'OPEN EXCEL FILES
Do While Len(Filename) > 0 'IF NEXT FILE EXISTS THEN
Set wbk = Workbooks.Open(Path & Filename)
Sheets("Weekoverzicht").Select
'Unprotect sheet
ActiveSheet.Unprotect Password:="cirules"
'Copy data from source
Range("B5:h23").SpecialCells(xlCellTypeVisible).Copy
'Paste data in Sheet 1
ThisWorkbook.Sheets("Sheet1").Range("AS" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
'Protect sheet again
ActiveSheet.protect Password:="cirules"


'Prevents question for copy clipboard
Application.CutCopyMode = False


'wbk.Close = don't save
wbk.Close False
Filename = Dir
Loop




Any ideas?