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

M2909

New Member
Joined
Jan 30, 2018
Messages
10
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
 
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?
 
Upvote 0

Excel Facts

What is the last column in Excel?
Excel columns run from A to Z, AA to AZ, AAA to XFD. The last column is XFD.

Forum statistics

Threads
1,224,823
Messages
6,181,183
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top