How can I retrieve specific cell values from multiple Excel files and record these values and their file name in a row of a master workbook?

Question

I have about 400 Excel files each containing four sheets. Each file is formatted the same way.

I would like to extract values from specific cells from the first three sheets in each file and paste these values into a new master workbook with a row for each file, recording the file name in a column at the front of each row.

I have using a limited macro and copy and paste.

My process

Open the excel file
Make a new sheet
Run the macro below
Copy and paste the macro output into a separate master workbook and type the file name in the adjacent column.

Sub Research_data_extraction_macro()
Research_data_extraction_macro Macro
Keyboard Shortcut: Ctrl+k
    Sheets("Day1").Select
    Range("F23:I23").Select
    Selection.Copy
    Sheets("DATA  EXTRACTION").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Sheets("Day1").Select
    Range("F24:I24").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("DATA  EXTRACTION").Select
    Range("E2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Sheets("Day1").Select
    Range("F31:I31").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("DATA  EXTRACTION").Select
    Range("I2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Sheets("Day2").Select
    Range("F23:I23").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("DATA  EXTRACTION").Select
    Range("M2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Sheets("Day2").Select
    Range("F24:I24").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("DATA  EXTRACTION").Select
    Range("Q2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Sheets("Day2").Select
    Range("F31:I31").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("DATA  EXTRACTION").Select
    Range("U2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Sheets("Day3").Select
    Range("C23:F23").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("DATA  EXTRACTION").Select
    Range("Y2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Sheets("Day3").Select
    Range("C43:F43").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("DATA  EXTRACTION").Select
    Range("AC2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Sheets("Day3").Select
    Range("C24:F24").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("DATA  EXTRACTION").Select
    Range("AG2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Sheets("Day3").Select
    Range("C44:F44").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("DATA  EXTRACTION").Select
    Range("AK2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Sheets("Day3").Select
    Range("C51:F51").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("DATA  EXTRACTION").Select
    Range("AO2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
End Sub

What would I need to add to run these steps on multiple files without opening them each time?
Is there a way to extract the file name and place it in a column next to each row?

If the files are in the same folder, then use [loop through files in a folder](https://stackoverflow.com/questions/10380312/loop-through-files-in-a-folder-using-vba). — BigBen, Oct 04 '22 at 20:31
Also pretty much requisite VBA/Excel reading: [how to avoid using Select](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba). — BigBen, Oct 04 '22 at 20:32
`1) Open the excel file, 2) Make a new sheet, 3) Run the macro, 4) Copy and paste ..` Are you doing this 400 times? 400 new sheets? — dcromley, Oct 04 '22 at 21:33

score 0 · Answer 1 · answered Oct 05 '22 at 06:24

If I understand you correctly, maybe you want to try this :

Sub test()
'mulai = Timer
Dim p As String: Dim fn As String: Dim frml As String
Dim oStart As Range: Dim rgFn As Range: Dim rgFrml As Range
Dim arrSh: Dim arrCol: Dim arrRow: Dim arrFrml
Dim s: Dim r: Dim c

Application.ScreenUpdating = False
p = "D:\test\" 'change as needed
fn = "dummy.xlsx"
frml = "%'" & p & "[" & fn & "]"

'create template formula for sheet Day1 and Day2
Set oStart = Range("XFD1")
arrSh = Array("Day1", "Day2")
arrCol = Array("F", "G", "H", "I")
arrRow = Array("23", "24", "31")

For Each s In arrSh
    For Each r In arrRow
        For Each c In arrCol
            oStart.Value = frml & s & "'!" & c & r
            Set oStart = oStart.Offset(1, 0)
        Next
    Next
Next

'create template formula for sheet Day3
arrCol = Array("C", "D", "E", "F")
arrRow = Array("23", "43", "24", "44", "51")
    For Each r In arrRow
        For Each c In arrCol
            oStart.Value = frml & "Day3'!" & c & r
            Set oStart = oStart.Offset(1, 0)
        Next
    Next

'create array of the formula as arrFrml variable
Set rgFn = Range("A2")
With Range("XFD1", Range("XFD1").End(xlDown))
Set rgFrml = rgFn.Offset(0, 1).Resize(1, .Rows.Count)
arrFrml = Application.Transpose(.Value)
.Clear
End With

'loop to each file in the folder
'then write the file name and the formula
fn = Dir(p)
    Do While Len(fn) > 0
        rgFn.Value = fn
            With rgFrml
                .Value = arrFrml
                .Replace What:="dummy.xlsx", Replacement:=fn, LookAt:=xlPart
                .Replace What:="%", Replacement:="=", LookAt:=xlPart
                .Value = .Value
            End With
        Set rgFn = rgFn.Offset(1, 0)
        Set rgFrml = rgFrml.Offset(1, 0)
        fn = Dir
    Loop
Application.ScreenUpdating = True
'Debug.Print Timer - mulai
End Sub

Basically the sub just create a linked formula to each workbook in the folder. First it create a rows of formula as a "template" using "dummy.xlsx" as the file name, then it create those rows value as arrFrml variable.

Then it loop to each file in the folder, write the file name in column A, write the formula start in column B, then replace the "dummy.xlsx" with the file name.

I test it with 128 files (each around 10kb file size), it takes around 12 seconds to finish the sub.

If you want to test the code, make a test folder with name "test" in drive D ---> p = "D:\test\", contains the copy of those 400 excel workbook. Create a new workbook (no need to save the workbook), copy the sub above then paste it in this new workbook macro module then run the code on the active any blank sheet.

Thank you so much for your help! The code you provided is working except I keep getting the error message: " Cannot find '/Users/abeech02/Desktop/test[lmstudy_172.xlsx]Day1'. Copy from: " and then it makes me hand select each file and sheet for each cell it extracts the value from. Is there a way to fix this? I'm working on a mac if that's relevant — Abby Beech, Oct 05 '22 at 23:45
In this line `p = "D:\test\"` , is your code like this ? `p="/Users/abeech02/Desktop/test"` ? Anyway, if you put the test folder (contains those 400 copied workbook to be tested) on your desktop, I think it should be like this : `p= "C:\Users\abeech02\Desktop\test\"`. Assuming that your PC has drive D, then the easy step to test the sub, make the test folder on drive D (so no need to change the `p = "D:\test\"`) . Thank you. — karma, Oct 08 '22 at 03:46

How can I retrieve specific cell values from multiple Excel files and record these values and their file name in a row of a master workbook?

1 Answers1