Pull data from folder into Multiple Excel File

[BPMDBal18]

Hello All,

I am trying to pull about 100 excel files that are all formatted identically the same and located in one folder into a consolidated excel sheet. The file is formatted as the following:

Cells A9-BF9 have the same title header information. I would like to pull this into the top row on the master file if possible. If not, I can pull this in manually.
Cells A10-BF10 contains the data that I need to pull-in for each spreadsheet.


I imagine this should be relatively easy, but I can't seem to get the VBA code to work. Any help would be greatly appreciated. Thanks!

 

[Norie]

What code have you tried?

 

[BPMDBal18]

This is what I tried to modify, however, I'm pretty new to VBA and can't seem to modify it correctly. I'm not entirely sure of the changes that I need to make to get it working.

Option Explicit

Sub ImportGroups()
Dim fPATH As String, fNAME As String
Dim LR As Long, NR As Long
Dim wbGRP As Workbook, wsDEST As Worksheet

Set wsDEST = ThisWorkbook.Sheets("Summary")
NR = wsDEST.Range("B" & Rows.Count).End(xlUp).Row + 1

fPATH = "C:\2011\GroupFiles" 'remember the final \ in this string

fNAME = Dir(fPATH & "*.xls") 'get the first filename in fpath

Do While Len(fNAME) > 0
Set wbGRP = Workbooks.Open(fPATH & fNAME) 'open the file
LR = Range("B" & Rows.Count).End(xlUp).Row 'how many rows of info?

If LR > 3 Then
wsDEST.Range("A" & NR) = Replace(Range("A1"), "Group ", "")
Range("B4:E" & LR).Copy wsDEST.Range("B" & NR)
NR = wsDEST.Range("B" & Rows.Count).End(xlUp).Row + 1
End If

wbGRP.Close False 'close data workbook
fNAME = Dir 'get the next filename
Loop

With Range("A3:A" & NR - 1)
.FormulaR1C1 = "=R[-1]C"
.Value = .Value
End With

End Sub

 

[BPMDBal18]

Option Explicit

Sub Consolidate()


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("Sheet1")    'sheet report is built into


With wsMaster
    If MsgBox("Clear the old data first?", vbYesNo) = vbYes Then
        .UsedRange.Offset(1).EntireRow.Clear
        NR = 2
    Else
        NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1    'appends data to existing data
    End If


'Path and filename (edit this section to suit)
MsgBox "Please select a folder with files to consolidate"
    Do
        With Application.FileDialog(msoFileDialogFolderPicker)
            .InitialFileName = "path"
            .AllowMultiSelect = False
            .Show
            If .SelectedItems.Count > 0 Then
                fPath = .SelectedItems(1) & "\"
                Exit Do
            Else
                If MsgBox("No folder chose, do you wish to abort?", _
                    vbYesNo) = vbYes Then Exit Sub
            End If
        End With
    Loop
    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
            LR = Range("A" & Rows.Count).End(xlUp).Row  'Find last row
            Range("A1:A" & LR).EntireRow.Copy .Range("A" & NR)
            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
        End If
        fName = Dir                                       'ready next filename
    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

 

[Norie]

The part to loop through files looks fine, this is the part you need to replace.

        'This is the section to customize, replace with your own action code as needed
            LR = Range("A" & Rows.Count).End(xlUp).Row  'Find last row
            Range("A1:A" & LR).EntireRow.Copy .Range("A" & NR)
            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

That shouldn't be too difficult as you are working with fixed ranges, ie A9:BF9 and A10:BF10.

Where do you want to copy the data to?

A specific sheet or a new sheet?

How should it be copied?

Should it be a row of data from each file?

Do you need to add anything to the data, eg a filename, timestamp?

 

[BPMDBal18]

Thanks! In general I think the range that I want to import from the files is A9:BF9. However, I just realized that the location of the line that I want to pull in changes slightly (i.e. to A10:BF10) in some files. It would be great if the code could look for the words "Company Name" (This is the header row) and pull in the entire row beneath it. For example, in file 1 company name is in A9, so I would want to pull in the information underneath this (A10:BF10). In file 2, company name is in A10, so I would want to pull in the data from A11:BF11.

If this isn't possible. I could always just pull in a range of rows and filter out the information that I don't need later.

Copying this to a new sheet would work fine. If it copies the information with formatting that would be great.

Yes, this would be one row of data from each file. A filename would be good information to pull in as well for tracking purposes.

 

[BPMDBal18]

Anyone have any ideas?