Extract cell data from a folder of workbooks

[Mattyo]

Hi Guys,

I am am new to this forum and although a reasonable user of excel have never dabbled in VB. I will be buying a book next week but in the meantime, I'm hoping to speed up the learning here!

I am wondering if you can help me with my problem, I have searched and found some similar scenarios but all slightly different requirements to mine.....

I have a folder full of invoices and want to extract various cell values from Sheet1 of all of the workbooks in that folder. Then, the data from each workbook populating a row in Sheet1 of a seperate master Workbook. For starters it will be cells: H1,C10,C11,C12,C13,H10,I41

Ideally, I don't want to open each file individually as there are a few hundred and it is no problem to have this Master workbook in the same folder.

I use Excel 2007 and Windows Vista Home Premium.

Thanks in advance, I really appreciate the help!

 

[jbeaucaire]

Here's a macro for collecting data from all files in a specific folder.

Workbooks to 1 Sheet​

To use this macro, first name a sheet "Master" in your workbook and make sure your titles are laid out across row 1 as needed.

Then put the macro into a regular code module in the vbeditor (Insert > Module), like Module1.

Edit the macro to include the correct fPath, the full path to the folder where you store the files to import.

In the section "this is the section to customize", I would recommend this code replace that section:

        'This is the section to customize, replace with your own action code as needed
            'copy the cells you want
            .Range("A" & NR) = [H1]
            .Range("B" & NR).Resize(, 4) = [Transpose(C10:C13)]
            .Range("F" & NR) = [H10]
            .Range("G" & NR) = [I41]
            
            wbData.Close False                                'close file
            NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1  'Next row
            Name fPath & fName As fPathDone & fName           'move file to IMPORTED folder
            fName = Dir                                       'ready next filename
        End If

So, here's the fully edited down code, just be sure to correct the fPath so the files are found.

Option Explicit

Sub Consolidate()
'Author:     Jerry Beaucaire'
'Date:       9/15/2009     (2007 compatible)  (updated 4/29/2011)
'Summary:    Merge files in a specific folder into one master sheet (stacked)
'            Moves imported files into another folder

Dim fName As String, fPath As String, fPathDone As String
Dim LR As Long, NR As Long
Dim wbData As Workbook, wsMaster As Worksheet

'Setup
    Application.ScreenUpdating = False  'speed up macro execution
    Application.EnableEvents = False    'turn off other macros for now
    Application.DisplayAlerts = False   'turn off system messages for now
    
    Set wsMaster = ThisWorkbook.Sheets("Master")    'sheet report is built into

With wsMaster
    NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1    'appends data to existing data

'Path and filename (edit this section to suit)
    fPath = "C:\2011\Files\"            'remember final \ in this string
    fPathDone = fPath & "Imported\"     'remember final \ in this string
    On Error Resume Next
        MkDir fPathDone                 'creates the completed folder if missing
    On Error GoTo 0
    fName = Dir(fPath & "*.xls*")       'listing of desired files, edit filter as desired

'Import a sheet from found files
    Do While Len(fName) > 0
        If fName <> ThisWorkbook.Name Then              'don't reopen this file accidentally
            Set wbData = Workbooks.Open(fPath & fName)  'Open file

        'This is the section to customize, replace with your own action code as needed
            'copy the cells you want
            .Range("A" & NR) = [H1]
            .Range("B" & NR).Resize(, 4) = [Transpose(C10:C13)]
            .Range("F" & NR) = [H10]
            .Range("G" & NR) = [I41]
            
            wbData.Close False                                'close file
            NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1  'Next row
            Name fPath & fName As fPathDone & fName           'move file to IMPORTED folder
            fName = Dir                                       'ready next filename
        End If
    Loop
End With

ErrorExit:    'Cleanup
    ActiveSheet.Columns.AutoFit
    Application.DisplayAlerts = True         'turn system alerts back on
    Application.EnableEvents = True          'turn other macros back on
    Application.ScreenUpdating = True        'refreshes the screen
End Sub

Note, this macro will take all the files in the fPath and import them one at a time, the files are being opened, but it's done in the background, so it should be pretty quick overall.

Also, after a file is imported it is moved into a folder called IMPORTED so that it isn't accidentally imported a second time when you run the macro again.

 

[Mattyo]

Thanks very much for that jerry, most kind of you!

Well, I have just tried it and get a script error message. When I name sheet1 of the Master, also Master. This script error does not occur but also, nothing happens then?

Could you take a look at this? I have created Master as a Macro enabled workbook.

Many thanks,

Matt.

Option Explicit
Sub Consolidate()
'Author: Jerry Beaucaire'
'Date: 9/15/2009 (2007 compatible) (updated 4/29/2011)
'Summary: Merge files in a specific folder into one master sheet (stacked)
' Moves imported files into another folder
Dim fName As String, fPath As String, fPathDone As String
Dim LR As Long, NR As Long
Dim wbData As Workbook, wsMaster As Worksheet
'Setup
Application.ScreenUpdating = False 'speed up macro execution
Application.EnableEvents = False 'turn off other macros for now
Application.DisplayAlerts = False 'turn off system messages for now

Set wsMaster = ThisWorkbook.Sheets("Master") 'sheet report is built into
With wsMaster
NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1 'appends data to existing data
'Path and filename (edit this section to suit)
fPath = "C:\Users\Matt\Documents\MD Motorcare\Books and Records\"
'remember final \ in this string
fPathDone = fPath & "C:\Users\Matt\Documents\MD Motorcare\Books and Records\Imported\" 'remember final \ in this string
On Error Resume Next
MkDir fPathDone 'creates the completed folder if missing
On Error GoTo 0
fName = Dir(fPath & "*.xls*") 'listing of desired files, edit filter as desired
'Import a sheet from found files
Do While Len(fName) > 0
If fName <> ThisWorkbook.Name Then 'don't reopen this file accidentally
Set wbData = Workbooks.Open(fPath & fName) 'Open file
'This is the section to customize, replace with your own action code as needed
'copy the cells you want
.Range("A" & NR) = [H1]
.Range("B" & NR).Resize(, 4) = [Transpose(C10:C13)]
.Range("F" & NR) = [H10]
.Range("G" & NR) = [I41]

wbData.Close False 'close file
NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1 'Next row
Name fPath & fName As fPathDone & fName 'move file to IMPORTED folder
fName = Dir 'ready next filename
End If
Loop
End With
ErrorExit: 'Cleanup
ActiveSheet.Columns.AutoFit
Application.DisplayAlerts = True 'turn system alerts back on
Application.EnableEvents = True 'turn other macros back on
Application.ScreenUpdating = True 'refreshes the screen
End Sub

 

[jbeaucaire]

The code has been used in tons of projects, so the basis is sound. Now that you've overcome the problem with the sheet name, it's now down to just seeing which line of code isn't doing what is expected.

In the VBEditor, use F8 to start the code and go through one line of code at a time, see which line doesn't do what is supposed to. How many files are in that folder?

Perhaps you need to tweak the filter used in the DIR() command.

fName = Dir(fPath & "*.xls*") 'listing of desired files, edit filter as desired

Could be "*.xlsx" ?

 

[Mattyo]

Hi Jerry,

Yes I noticed it was looking for xls but that is ok as the files are created on another PC that has 2003 on it. Ok with that one for now although I would like to select xls OR xlsx if that is possible?

When running through with F8, it stops here:

Name fPath & fName As fPathDone & fName 'move file to IMPORTED folder

This is the last line to go yellow and I am unable to move onto the next one:

fName = Dir

Cheers,

Matt.

 

[jbeaucaire]

Look in your folder with the files, did the macro create a folder called IMPORTED inside that folder? It should have.


If there are no other files in that folder other than the ones you want imported, and you want them ALL imported, then you could just use this for the filter: "*.*"

 

[Mattyo]

Hi Jerry,

Think I'm nearly there, a mixture of finger trouble and lack of understanding on my part. I had the full address in the fPathDone line. Changed to as below and I have created a folder called Imported.

'Path and filename (edit this section to suit)
    fPath = "C:\Users\Matt\Documents\MD Motorcare\Books and Records\Invoices_2010-11\"
    'remember final \ in this string
    fPathDone = fPath & "Imported\"     'remember final \ in this string

Right, Macro runs, every file gets imported as advertised but my Master sheet remains empty! So close.....

 

[hiker95]

Mattyo,

The following macro will, without opening the workbooks, get the workbooks, Sheet1, cells, via formulae, and then change the formulae to values.

It will also list in column A the filename for the respective cells.

We may have to change some of the column formatting depending on what was in the respective cells.


Before you run the macro, make sure you change the:
'********** change folder\directory path **********
'MyDir = "D:\Documents\Survey\Returns"
MyDir = "D:\Documents\Survey\Returns"




Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).


1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Option Explicit
Sub GetMyData()
' hiker95, 05/08/2011
' http://www.mrexcel.com/forum/showthread.php?t=548601
Dim MyDir As String, FN As String, SN As String, NR As Long
Application.ScreenUpdating = False

'********** change folder\directory path **********
'MyDir = "D:\Documents\Survey\Returns"
MyDir = "D:\Documents\Survey\Returns"

'********** change the sheet name of the sheet in the closed workbooks **********
'SN = "Sheet1"
SN = "Sheet1"

'******** change the .xls to .xlsx if the workbooks are Excel 2007 **********
'FN = Dir(MyDir & "\*.xls")
FN = Dir(MyDir & "\*.xls*")

ThisWorkbook.Sheets("Sheet1").Activate
ThisWorkbook.Sheets("Sheet1").Range("A1:H1") = [{"Filename","H1","C10","C11","C12","C13","H10","I41"}]
NR = 2
Do While FN <> ""
  If FN <> ThisWorkbook.Name Then
    With ThisWorkbook.Sheets("Sheet1").Range("B" & NR)
      'Workbook Name
      .Offset(, -1) = FN
      .Formula = "='" & MyDir & "\[" & FN & "]" & SN & "'!H1"
      .Value = .Value
      With .Offset(, 1)
        .Formula = "='" & MyDir & "\[" & FN & "]" & SN & "'!C10"
        .Value = .Value
      End With
      With .Offset(, 2)
        .Formula = "='" & MyDir & "\[" & FN & "]" & SN & "'!C11"
        .Value = .Value
      End With
      With .Offset(, 3)
        .Formula = "='" & MyDir & "\[" & FN & "]" & SN & "'!C12"
        .Value = .Value
      End With
      With .Offset(, 4)
        .Formula = "='" & MyDir & "\[" & FN & "]" & SN & "'!C13"
        .Value = .Value
      End With
      With .Offset(, 5)
        .Formula = "='" & MyDir & "\[" & FN & "]" & SN & "'!H10"
        .Value = .Value
      End With
      With .Offset(, 6)
        .Formula = "='" & MyDir & "\[" & FN & "]" & SN & "'!I41"
        .Value = .Value
      End With
  End If
  FN = Dir
  NR = NR + 1
Loop
Sheets("Sheet1").UsedRange.Columns.AutoFit
Application.ScreenUpdating = False
End Sub

Then run the GetMyData macro.

 

[Mattyo]

Hi there,

Thanks very much! Just tried it and got the following message:

Compile error: End If woithout Block If

What do you think?

Cheers,

Matt.

 

[hiker95]

Mattyo,

Ooops!!!


Make any changes per my last post, and then try this:



Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Option Explicit
Sub GetMyData()
' hiker95, 05/08/2011
' http://www.mrexcel.com/forum/showthread.php?t=548601
Dim MyDir As String, FN As String, SN As String, NR As Long
Application.ScreenUpdating = False

'********** change folder\directory path **********
'MyDir = "D:\Documents\Survey\Returns"

MyDir = "D:\Documents\Survey\Returns"

'********** change the sheet name of the sheet in the closed workbooks **********
'SN = "Sheet1"
SN = "Sheet1"

'******** change the .xls to .xlsx if the workbooks are Excel 2007 **********
'FN = Dir(MyDir & "\*.xls")
FN = Dir(MyDir & "\*.xls*")

ThisWorkbook.Sheets("Sheet1").Activate
ThisWorkbook.Sheets("Sheet1").Range("A1:H1") = [{"Filename","H1","C10","C11","C12","C13","H10","I41"}]
NR = 2
Do While FN <> ""
  If FN <> ThisWorkbook.Name Then
    With ThisWorkbook.Sheets("Sheet1").Range("B" & NR)
      'Workbook Name
      .Offset(, -1) = FN
      .Formula = "='" & MyDir & "\[" & FN & "]" & SN & "'!H1"
      .Value = .Value
      With .Offset(, 1)
        .Formula = "='" & MyDir & "\[" & FN & "]" & SN & "'!C10"
        .Value = .Value
      End With
      With .Offset(, 2)
        .Formula = "='" & MyDir & "\[" & FN & "]" & SN & "'!C11"
        .Value = .Value
      End With
      With .Offset(, 3)
        .Formula = "='" & MyDir & "\[" & FN & "]" & SN & "'!C12"
        .Value = .Value
      End With
      With .Offset(, 4)
        .Formula = "='" & MyDir & "\[" & FN & "]" & SN & "'!C13"
        .Value = .Value
      End With
      With .Offset(, 5)
        .Formula = "='" & MyDir & "\[" & FN & "]" & SN & "'!H10"
        .Value = .Value
      End With
      With .Offset(, 6)
        .Formula = "='" & MyDir & "\[" & FN & "]" & SN & "'!I41"
        .Value = .Value
      End With
    End With
  End If
  FN = Dir
  NR = NR + 1
Loop
Sheets("Sheet1").UsedRange.Columns.AutoFit
Application.ScreenUpdating = False
End Sub