Get data from several closed xls files

I have been given the unenviable task of trying to get data from no less that 49 seperate workbooks (in a different Folder) into one Master workbook.

The data I need is in the same place in every workbook (A4:C15). So far I have used John Walkenbach's "GetValue from a closed workbook" to populate the same range on the master. I have been able to modify it to read the data from the different closed workbooks however I have been unable to modify the code to write to a new range (3 cells to the right) for each workbook. It therefore just keeps over-writing the same range of cells in the Master.

I have found and written some code to read all the Excel file names of the 49 files in the folder and write them into seperate rows in another sheet in the Master workbook. I was hoping I might be able to utilise this "File name" sheet in some way although I am not sure how or if at all yet.

Can anyone offer any advise/assistance ?

without seeing your code it's rather difficult to tell you what you are doing wrong.

Post your code, or post your workbook, and I'm sure someone will help you out.

this file will take a single range from multiple workbooks and save to the sheet labled data.

i didn't invent it but copied it some time ago either from oz grid or mrexcel but i have automated it a bit.

GlenUK: Sorry mate, I was just expecting to get a few suggestions on how to tackle the problem but please find the code I have cobbled together below. I have moved on a little since I last posted. I have managed to get the macro to:
1. Count the number of Excel files in the "Regions" folder (The number will change from week to week)
2. List the Excel file names in the "Files" worksheet (in the "Metrics" workbook).
3. Create a new worksheet for every Excel file found in "Regions" folder and named accordingly.
4. Get the values from 100 cells (however I would like all values from populated cells in column 1) in column 1 from the closed workbooks in the "Regions" folder and written into the respective worksheets in the "Metrics" workbook.

The values that I am collecting from the Regions workbooks are record reference codes (ie. BBRY7010 or ADBE7922,etc). At some point I will need the macro to read a ref code from the new worksheets, look for it in a "Master" workbook and pull out its status from a "Status" column in the "Master". Finally I need the macro to produce a summary of the number of ref codes for a particular region which are of a particular status ie How many of Russia's Ref codes are at status "Production Ready", how many are in "UAT", etc (there are 6 different status's).

If you can stand to read anymore here follows an explanation of what I have walked into. The small team I have just joined have been struggling with this mess of workbooks for over a year now. The "Macro/Formula" guy left the week before I started. The Deputy has to produce a report once a week. This involves copying vlookup formulas and Index/Match formulas (they haven't even decided to use one or the other) into at least 12 columns of each "Regions" workbooks and manually copying (by dragging) them down each column through between 200 to 2500 records. Having copied all these formulae into the thousands of cells in the different regions workbooks this then produces the correct figures (using VLookup or Index/Match formulae) for a summary table on a "Summaries" sheet in each region's workbook. The Deputy then manually copies and pastes values from each region's "Summary" worksheet into respective pre-prepared tables on a "Summaries" workbook. You can imagine how long this takes considering he has to wait for each of the 49 workbooks to open before he conducts his little formulae copying exercise. To make matters worse 2 of the team (the Leader and the Deputy) are on a Citrix thin client using Vista and Office2007 while I and the other 3 are on the outgoing system which is XP with Office2003. The Citrix system is awfully slow. The Deputy has to produce these summary reports every week and doesnt finish till 9 or 10pm due to the combined issues described above.

I know this is all a bit long winded but I need to do this Excel/VBA macro stuff as a firefighting measure first. When I get this done it will buy me the time to get the whole sorry mess into an Access database.

Any help or advise (other than "Run away!") would be much appreciated.

====================The code===============================

Const strMetrics = "\\.server.\.path.\DevArea\Metrics.xls"
Const strReportsPath = "\\.server.\.path.\DevArea\Regions\"

Dim strFileName As String
Dim FileCount As Integer

Sub Summaries()
'=========================================================
'
' Summaries Macro
' Macro recorded 24/06/2008 by Mark
'=========================================================

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Call GetFileNames ' Looks in Regions folder for excel files and writes the file names into rows in the Files sheet.

Call PopRegionTables

'?????????????????????????????????????????????
'
' The rest of the code goes here
'
'?????????????????????????????????????????????

MsgBox "Data population of Summary reports is complete"

End Sub

Function GetFileNames()

Dim p As String, x As Variant

p = strReportsPath
x = GetFileList(p)

Select Case IsArray(x)
Case True 'files found
'MsgBox UBound(x) & " files found in Regions folder"
Sheets("Files").Range("A:A").Clear
For i = LBound(x) To UBound(x)
Sheets("Files").Cells(i, 1).Value = x(i)
Next i
Case False 'no files found
MsgBox "No matching files"
End Select

End Function

Function GetFileList(FileSpec As String) As Variant
' Returns an array of filenames that match FileSpec
' If no matching files are found, it returns False

Dim FileArray() As Variant
'Dim FileCount As Integer
Dim FileName As String

On Error GoTo NoFilesFound

FileCount = 0
FileName = Dir(FileSpec)
If FileName = "" Then GoTo NoFilesFound

' Loop until no more matching files are found
Do While FileName <> ""
FileCount = FileCount + 1
ReDim Preserve FileArray(1 To FileCount)
FileArray(FileCount) = FileName
FileName = Dir()
Loop
GetFileList = FileArray
Exit Function
' Error handler
NoFilesFound:
GetFileList = False
End Function
Function PopRegionTables()

Dim NewWks As Worksheet
Dim NewName As String

For i = 1 To FileCount

Set NewWks = Worksheets.Add
strFileName = Worksheets("Files").Cells(i, 1).Value
NewName = Trim(strFileName)
NewWks.Name = NewName

Call GetValueFmClosed 'from closed file strFileName into Sheet strFileName

Next i

End Function
Function GetValueFmClosed()

p = strReportsPath
f = strFileName
s = "App List"

Application.ScreenUpdating = False

For r = 2 To 100
'For c = 2 To 3
a = Cells(r, 2).Address
Cells(1, 1) = "Wrap ID"
Range("A1").Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
Columns("A:A").EntireColumn.AutoFit
Cells(r, 1) = GetValue(p, f, s, a)
'Next c
Next r

Application.ScreenUpdating = True

End Function

Function GetValue(path, file, sheet, ref)
'======================
'\\ John Walkenbach
'\\ http://www.j-walk.com/ss/excel/tips/tip82.htm
'\\ Retrieves a value from a closed workbook
'======================
Dim arg As String

' Make sure the file exists
If Right(path, 1) <> "\" Then path = path & "\"
If Dir(path & file) = "" Then
GetValue = "File Not Found"
Exit Function
End If

' Create the argument
arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
Range(ref).Range("A1").Address(, , xlR1C1)

' Execute an XLM macro
GetValue = ExecuteExcel4Macro(arg)
End Function

OC0nn0r,

Please read the Forum Rules and then wrap your code with Code Tags.

Sri and tks

Const strMetrics = "\\..path..\DevArea\Metrics.xls"
Const strReportsPath = "\\..path..\DevArea\Regions\"

Dim strFileName As String
Dim FileCount As Integer

Sub Summaries()
'============================================================================
'
' Summaries Macro
' Macro recorded 24/06/2008 by Mark
'
'============================================================================
    Application.ScreenUpdating = False 'Helps the macro to run faster
    Application.Calculation = xlCalculationManual
       
    Call GetFileNames   ' Looks in Regions folder for excel files and writes the file names into rows in the Files sheet.
        
    Call PopRegionTables
        
'?????????????????????????????????????????????
'
'  The rest of the code goes here
'
'?????????????????????????????????????????????
        
    MsgBox "Data population of Summary reports is complete"

End Sub

Function GetFileNames()

    Dim p As String, x As Variant

    p = strReportsPath
    x = GetFileList(p)
    
    Select Case IsArray(x)
        Case True 'files found
            MsgBox UBound(x) & " files found in Regions folder"
            Sheets("Files").Range("A:A").Clear
            For i = LBound(x) To UBound(x)
                Sheets("Files").Cells(i, 1).Value = x(i)
            Next i
        Case False 'no files found
            MsgBox "No matching files"
    End Select

End Function

Function GetFileList(FileSpec As String) As Variant
'   Returns an array of filenames that match FileSpec
'   If no matching files are found, it returns False

    Dim FileArray() As Variant
    'Dim FileCount As Integer
    Dim FileName As String
    
    On Error GoTo NoFilesFound

    FileCount = 0
    FileName = Dir(FileSpec)
    If FileName = "" Then GoTo NoFilesFound
    
'   Loop until no more matching files are found
    Do While FileName <> ""
        FileCount = FileCount + 1
        ReDim Preserve FileArray(1 To FileCount)
        FileArray(FileCount) = FileName
        FileName = Dir()
    Loop
    GetFileList = FileArray
    Exit Function
'   Error handler
NoFilesFound:
    GetFileList = False
End Function
Function PopRegionTables()

    Dim NewWks As Worksheet
    Dim NewName As String
    
        For i = 1 To FileCount
        
            Set NewWks = Worksheets.Add
            strFileName = Worksheets("Files").Cells(i, 1).Value
            NewName = Trim(strFileName)
            NewWks.Name = NewName

            Call GetValueFmClosed 'from closed file strFileName into Sheet strFileName
        
        Next i

End Function
Function GetValueFmClosed()
    
    p = strReportsPath
    f = strFileName
    s = "App List"
    
    Application.ScreenUpdating = False
    
    For r = 2 To 100
        'For c = 2 To 3
            a = Cells(r, 2).Address
            Cells(1, 1) = "Wrap ID"
            Range("A1").Select
                With Selection.Interior
                    .ColorIndex = 6
                    .Pattern = xlSolid
                End With
            Columns("A:A").EntireColumn.AutoFit
            Cells(r, 1) = GetValue(p, f, s, a)
        'Next c
    Next r
    
    Application.ScreenUpdating = True
    
End Function

Function GetValue(path, file, sheet, ref)
'======================
'\\ John Walkenbach
'\\ http://www.j-walk.com/ss/excel/tips/tip82.htm
'\\ Retrieves a value from a closed workbook
'======================
    Dim arg As String

'   Make sure the file exists
    If Right(path, 1) <> "\" Then path = path & "\"
    If Dir(path & file) = "" Then
        GetValue = "File Not Found"
        Exit Function
    End If

'   Create the argument
    arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
      Range(ref).Range("A1").Address(, , xlR1C1)

'   Execute an XLM macro
    GetValue = ExecuteExcel4Macro(arg)
End Function

Hi
Here is a file with a macro. Change the file path from G:\a\ to your current file path and run the macro. It lists all the files in that folder in row 2 and pulls data from col A of sheet 1 from each sheet (upto 250 rows). Try it and let me know.
Ravi

Many thanks to martindwilson and ravishankar. I will try your code and let you know how it went.