Sub CombineFiles() 
' Written by Barrie Davidson 
Dim Rollup_File_Name As String 
Dim File_Names As Variant 
Dim File_count As Integer 
Dim Active_File_Name As String 
Dim Counter As Integer 
Dim File_Save_Name As Variant 
    
File_Names = Application.GetOpenFilename _ 
    ("Excel Files (*.xl*), *.xl*", , , , True) 
Application.ScreenUpdating = False 
Application.DisplayAlerts = False 
File_count = UBound(File_Names) 
Counter =  1  
Workbooks.Add 
Rollup_File_Name = ActiveWorkbook.Name 
Do Until Counter > File_count 
    Active_File_Name = File_Names(Counter) 
    Workbooks.Open FileName:=Active_File_Name 
    Active_File_Name = ActiveWorkbook.Name 
    If Counter =  1  Then 
        Range("A1:K" & Range("A65536").End(xlUp).Row).Copy _ 
            Destination:=Workbooks(Rollup_File_Name). _ 
            Sheets( 1 ).Range("A1") 
    Else 
        Range("A2:K" & Range("A65536").End(xlUp).Row).Copy _ 
            Destination:=Workbooks(Rollup_File_Name). _ 
            Sheets( 1 ).Range("A65536").End(xlUp).Offset( 1 ,  0 ) 
    End If 
    Workbooks(Active_File_Name).Close False 
    Counter = Counter +  1  
Loop 
GetSaveName: 
File_Save_Name = Application.GetSaveAsFilename(, _ 
    "Excel Files (*.xls), *.xls") 
Select Case File_Save_Name 
    Case Is = False 
        MsgBox ("Please enter a file name to save the file") 
        GoTo GetSaveName 
    Case Is = "" 
        MsgBox ("Please enter a file name to save the file") 
        GoTo GetSaveName 
    Case Else 
End Select 
Workbooks(Rollup_File_Name).SaveAs FileName:=File_Save_Name 
Application.ScreenUpdating = True 
Application.DisplayAlerts = True 
End Sub 

ListBox1.List = rs.GetRows(NoOfRecords)

Private Sub UserForm_Initialize()

    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim NoOfRecords As Long

    ' Open the database
    Set db = OpenDatabase("C:\Test\Book1.xls", False, False, "Excel 8.0")

    ' Retrieve the recordset
    Set rs = db.OpenRecordset("SELECT * FROM `myDatabase`")

    ' Determine the number of retrieved records
    With rs
         .MoveLast
         NoOfRecords = .RecordCount
         .MoveFirst
    End With

    ' Set the number of Columns = number of Fields in recordset
    ListBox1.ColumnCount = rs.Fields.Count

    ' Load the ListBox with the retrieved records
    ListBox1.Column = rs.GetRows(NoOfRecords)

    ' Cleanup
    rs.Close
    db.Close

    Set rs = Nothing
    Set db = Nothing

End Sub

'CWRIA is short for ClosedWorkbookRangeIntoArray

Function CWRIA(fPath As String, fName As String, sName As String, _
	     rng As String)
    Dim sRow As Integer
    Dim sColumn  As Integer
    Dim sRows As Integer
    Dim sColumns  As Integer
    Dim vrow As Integer
    Dim vcol  As Integer
    Dim fpStr As String
    Dim cArr()
    On Error GoTo NoArr
    If Right(fPath,  1 ) <> "\" Then fPath = fPath & "\"
    If Dir(fPath & fName) = "" Then
        CWA = CVErr(xlErrValue)
        Exit Function
    End If
    sRow = Range(rng).Row
    sColumn = Range(rng).Column
    sRows = Range(rng).Rows.Count
    sColumns = Range(rng).Columns.Count
    ReDim cArr(sRows, sColumns)
    For vrow =  1  To sRows
        For vcol =  1  To sColumns
            fpStr = "'" & fPath & "[" & fName & "]" & sName & "'!" & _
            "r" & sRow + vrow -  1  & "c" & sColumn + vcol -  1 
            cArr(vrow, vcol) = ExecuteExcel4Macro(fpStr)
        Next
    Next
    CWRIA = cArr
    Exit Function
NoArr:
    CWRIA = CVErr(xlErrValue)
End Function


'CWRIR is short for ClosedWorkbookRangeIntoArray

Sub CWRIR(fPath As String, fName As String, sName As String, _
	     rng As String, destRngUpperLeftCell As String )
    Dim sRow As Integer
    Dim sColumn  As Integer
    Dim sRows As Integer
    Dim sColumns  As Integer
    Dim vrow As Integer
    Dim vcol  As Integer
    Dim fpStr As String
    Dim cArr()
    On Error GoTo NoArr
    If Right(fPath,  1 ) <> "\" Then fPath = fPath & "\"
    If Dir(fPath & fName) = "" Then
        CWA = CVErr(xlErrValue)
        Exit Function
    End If
    sRow = Range(rng).Row
    sColumn = Range(rng).Column
    sRows = Range(rng).Rows.Count
    sColumns = Range(rng).Columns.Count
    ReDim cArr(sRows, sColumns)
    Set destRange = ActiveSheet.Range(destRngUpperLeftCell) 
    For vrow =  1  To sRows
        For vcol =  1  To sColumns
            fpStr = "'" & fPath & "[" & fName & "]" & sName & "'!" & _
            "r" & sRow + vrow -  1  & "c" & sColumn + vcol -  1 
            destRange.Offset(vrow -  1 , vcol -  1 ) = ExecuteExcel4Macro(fpStr)
        Next
    Next
NoArr:
End Sub

The following procedure copies the values from the range A1:C3 from Sheet1 of
the closed workbook cellDataVal.xls located at D:\EXCEL97\xlformulas to the
range F9:H11 on the active worksheet.   

Sub InsertRangeFromClosedWorkbook()
    CWRIR "D:\EXCEL97\xlformulas", "cellDataVal.xls", "Sheet1", _
    "a1:c3", "f9"
End Sub