Thread: list from many workbooks and file open

Dear sir / madam

Can someone please help me?

I’ve got a workbook named (“Summary”) and a folder named “Employee workbooks”.

The workbooks in the “Employee Workbooks” folder are workbooks that my employees will be working on. I will be working on the “Summary” workbook.

What I would like is a macro that will extract the data from cells (b2, b3, b4, e2, e3) from all the employee workbooks and list them in my “Summary” workbook below each other.

Also a macro that when I click on an employee’s number in the list in my “Summary” workbook that employee’s workbook will automatically open.

Thank you

Here's my stock macro adjusted for your scenario.

Code:

Option Explicit

Sub Consolidate()
'Author:     JBeaucaire'
'Date:       3/11/2010     (2007 compatible)'
'Summary:    Open all Excel files in a specific folder and merge data'
'            into one master sheet (stacked)'
'            creates hyperlink to each imported file'
Dim fName As String, fPath As String, fPathDone As String, OldDir As String
Dim LR As Long, NR As Long
Dim wbkOld As Workbook, wbkNew As Workbook, ws As Worksheet

'Setup'
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    
    Set wbkNew = ThisWorkbook
    wbkNew.Activate
    Sheets("Summary").Activate   'sheet report is built into'
    
    If MsgBox("Import new data to this report?", vbYesNo) = vbNo Then Exit Sub
    
    If MsgBox("Clear the old data first?", vbYesNo) = vbYes Then
        Range("A2:E" & Rows.Count).Clear
        NR = 2
    Else
        NR = Range("A" & Rows.Count).End(xlUp).Row + 1
    End If

'Path and filename'
    OldDir = CurDir             'memorizes the current working path'
    fPath = "C:\Documents and Settings\Juanita du Preez\Desktop\Work\Employee Worksheets\"
    ChDir fPath
    fName = Dir("EMP*.xls")      'filtering key, change to suit'

'Import a sheet from found file'
    Do While Len(fName) > 0
        'Open file'
            Set wbkOld = Workbooks.Open(fName)
        'copy data'
            With Sheets("Sheet1")
                wbkNew.Sheets("Summary").Range("A" & NR) = .[B2]
                wbkNew.Sheets("Summary").Range("B" & NR) = .[B3]
                wbkNew.Sheets("Summary").Range("C" & NR) = .[B4]
                wbkNew.Sheets("Summary").Range("D" & NR) = .[E2]
                wbkNew.Sheets("Summary").Range("E" & NR) = .[E3]
            End With
        'close file'
            wbkOld.Close False
        'add hyperlink
            ActiveSheet.Hyperlinks.Add Anchor:=Range("A" & NR), Address:=fPath & fName, TextToDisplay:=Range("A" & NR).Text
        'Next row'
            NR = NR + 1
        'ready next filename'
            fName = Dir
    Loop

'Cleanup'
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True

'restores original working path'
    ChDir OldDir
End Sub

Thanks for the feedback, let me know how it works for you...