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