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

 

[steve the fish]

Hi. It looks like you are pasting the data back into the workbook where the data came from not into your summary workbook. I hope you have kept copies of these 200 workbooks because you then save them at the end. Which workbook/ sheet do you need the data pasted to?

 

[M2909]

Hi. It looks like you are pasting the data back into the workbook where the data came from not into your summary workbook. I hope you have kept copies of these 200 workbooks because you then save them at the end. Which workbook/ sheet do you need the data pasted to?

Hi Steve,

im pasting it in:

Sheet1.Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

since that workbook i open when the macro runs.

 

[M2909]

Hi. It looks like you are pasting the data back into the workbook where the data came from not into your summary workbook. I hope you have kept copies of these 200 workbooks because you then save them at the end. Which workbook/ sheet do you need the data pasted to?

There is actually no need to save them, which aspect is the VBA is saving the file now?

 

[steve the fish]

Which workbook are you wanting to paste in? Your code will paste into the workbook that has been opened provided it has a sheet with the code name Sheet1. The 'True' on wbk.Close True saves the file. Make it False.

 

[M2909]

Ok, changed it to False, thanks!


it needs to be pasted in:
W:\Quality\2018\DC.xlsx
in WorkSheet: Totals

In this sheet column A = date (1-1-2018 till 31-12-2018)
Row 1 is Machinenumber (1 p. column)

 

[steve the fish]

Ok so where have you placed the vba code? Which workbook is that in? Im not sure what you mean by the date and machine number??

 

[M2909]

Ok, the workbook is W:\Quality\2018\DC.xslm
the vba code is in this workbook to.

the data has to be pasted in WorkSheet: Totals

Where it has be to pasted:

Date	Year	Month	Week	A01	A02	A03	A04	A05
1-10-2017	2017	okt	40
2-10-2017	2017	okt	40
3-10-2017	2017	okt	40
4-10-2017	2017	okt	40
5-10-2017	2017	okt	40

<colgroup><col><col><col><col><col span="5"></colgroup><tbody>
</tbody>

What has to be copied:

	1-1-2018	2-1-2018	3-1-2018	4-1-2018	5-1-2018
Machine	Totaal %	Totaal %	Totaal %	Totaal %	Totaal %
A01	108%	108%	91%	107%	108%
A02
A03
A04	0%	3%	84%	102%	104%
A05	5%	50%	123%	119%	118%

<colgroup><col><col><col><col><col><col></colgroup><tbody>
</tbody>

Hope this makes it clear?
i can't attach the file..

 

[M2909]

I paste it using Transpose because i want the date vertically in column A, where the source is vice versa.

 

[steve the fish]

See if this does what you want:

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)
    With Sheets("Weekoverzicht")
        .Unprotect Password:="******"
        .Range("B7:Z29").SpecialCells(xlCellTypeVisible).Copy
        ThisWorkbook.Sheets("Totals").Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        .Protect Password:="******"
    End With
    'Prevents question for copy clipboard
    Application.CutCopyMode = False
    wbk.Close False
    Filename = Dir
Loop

Application.ScreenUpdating = True

End Sub