Extracting data from multiple files

Rob,

This macro will get the values of two cells from every workbook in a particular file and place them in a single workbook (the one containing the macro). When you say date, which date?

You could also do this using just formulas utilising the INDIRECT function.

Regards,
Daniel.

Sub ExtractData()
Dim strPath As String, shtDest As Worksheet, lngLoop As Long
Dim wbSource As Workbook

Application.ScreenUpdating = False
strPath = "C:\temp\year files" 'Change to suit your needs
Set shtDest = ThisWorkbook.Sheets("sheet1") 'Ditto

With Application.FileSearch
.NewSearch
.FileType = msoFileTypeExcelWorkbooks
.LookIn = strPath
.SearchSubFolders = False
.Execute
'Now search through all found files. Open the workbook and place it's values
'in this workbooks sheet1.
For lngLoop = 1 To .FoundFiles.Count
Set wbSource = Workbooks.Open(.FoundFiles(lngLoop))
shtDest.Cells(lngLoop, 1) = wbSource.Name
shtDest.Cells(lngLoop, 2) = wbSource.Sheets("sheet1").Range("A1")
shtDest.Cells(lngLoop, 3) = wbSource.Sheets("sheet1").Range("B1")
wbSource.Close False
Next lngLoop
End With

Application.ScreenUpdating = True

End Sub

This is nearly working, the Source directory is c:\Year 2000, the worksheet is labelled 'Extract', the two cells to grab are C25 & C26, as far as the "date" goes then the current code you gave is fine as it inserts the filename which is perfect.

I've had a play with the code but I can't get it right, i've never used vb or macros before.

TIA

Rob.

What is the actual problem then? The biggest potential problem I could see is any reference to 'sheet1' where you source worksheets may have different names. This code is slightly modified to match your changes specified:-

Regards,
Daniel.

Sub ExtractData()
Dim strPath As String, shtDest As Worksheet, lngLoop As Long
Dim wbSource As Workbook

Application.ScreenUpdating = False
strPath = "C:\year 2000" 'Change to suit your needs
Set shtDest = ThisWorkbook.Sheets("sheet1") 'Ditto

With Application.FileSearch
.NewSearch
.FileType = msoFileTypeExcelWorkbooks
.LookIn = strPath
.SearchSubFolders = False
.Execute
'Now search through all found files. Open the workbook and place it's values
'in this workbooks sheet1.
For lngLoop = 1 To .FoundFiles.Count
Set wbSource = Workbooks.Open(.FoundFiles(lngLoop))
shtDest.Cells(lngLoop, 1) = wbSource.Name
shtDest.Cells(lngLoop, 2) = wbSource.Sheets("sheet1").Range("C25")
shtDest.Cells(lngLoop, 3) = wbSource.Sheets("sheet1").Range("C26")
wbSource.Close False
Next lngLoop
End With

Application.ScreenUpdating = True

End Sub

Thanks Dank, I managed to get this to do what I needed although I had to put an error skip in due to "Subscript out of range" after it accessed the second file.

Cheers,

Rob.