Macro to compile data from multiple excel files into one summary file

[Kiwirunner]

Hi,

I have one hundred excel files that have the same identical format but have different guest names, guest addresses and arrival dates. What I am trying to do is write a macro that goes into each file, looks to see how many guest names are in each file and then copies this information along with the guests address information into a summary excel sheet.

The 100 identical excel files look as follows (each file will be saved as the group name i.e. "Group 12"):

A B C D E
1 Group 12
2
3 Guest Name Address Arrival Date
4 Joe Bloggs Australia 21/1/12
5 James Henry UK 22/1/12
6 Sarah Henry UK 22/1/12

I am trying to get the summary file to look as follows:

A B C D E
1 Summary File
2
3 Group Guest Name Address Arrival Date
4 12 Joe Bloggs Australia 21/1/12
5 12 James Henry UK 22/1/12
6 12 Sarah Henry UK 22/1/12
7 13 Andrew Walker UK 28/2/12
8 13 Kate Henly USA 29/2/12
9 14 Andy Eaden A 29/2/12

Any help in pointing me in the right direction here would be most appreciated.

Thanks and have a happy NYE!

 

[kyleclark123]

Hi All.

Please can you assist.

I need a <acronym title="visual basic for applications" style="border-width: 0px 0px 1px; border-top-style: initial; border-right-style: initial; border-bottom-style: dotted; border-left-style: initial; border-top-color: initial; border-right-color: initial; border-bottom-color: rgb(0, 0, 0); border-left-color: initial; border-image: initial; cursor: help; color: rgb(51, 51, 51); background-color: rgb(250, 250, 250);">VBA</acronym> Macro to combine workbooks in a folder into a "Master sheet".

1) I have a master workbook named e.g "Coin summary" that consolidates info from various different workbooks (format is exactly the same)
2) The different worksheets ranges (A14:O"Variable") - So will vary on all worksheets but end at "o"
3) Range A1:O13 is standard (header information) and will always remain the same
4) I want however (staff) save the workbooks in a folder names .eg. "ABSA recons",the master sheet should take the data of the various workbooks saved in the folder "ABSA recons" & consolidate into the master workbook
5) Everyday there will be a new folder e.g "10.05.2017" and the files will be carried forward day to day,but the consolidated "master sheet" should just take whatever is on the various sheets

Please can you assist - I can even send an example of format.

kind REGARDS
K

 

[jskasango]

Hi, I find this extremely useful! Is it possible to populate the data with col "A" having a label from a specific cell say "N6" from each file then collect the rest of the info from a specific row, say "Row 25"? Then specify what columns to collect? That will definately earn me a promotion!!!!

 

[jskasango]

By "populate the data with col "A" having a label from a specific cell", I would like to do this "picking of labels" for columns A to J then now collect data from specific columns starting from row 25. Sorry for the slow thinking.

 

[KyleRichJohn]

I have no experience with this and am a little stumped on how to get my results. I want to pull data from 400+ excel files all in one folder (N:\ENG\Intern\Packaging), and list them on one workbook. They are all identical format, there are 4 sheets in each workbook, but, I only need data pulled from the second worksheet labeled "PSDS."

I've tried cutting and pasting a few different codes on here but haven't been able to tweak them to make them work. Am I supposed to delete the different colored text in these codes?

If someone could help and give me some direction I would be extremely grateful.

The data I want to compile would be :
1. Part number____Cell G8
2. Part name______Cell G9
3. Annual Volume__Cell G10
4. Length_________Cell E32
5. Width__________Cell G32
4. Height_________Cell K32

This is the format I am trying to get the data to look like once compiled.

 

[KyleRichJohn]

Could someone post a code that they use that has the cells filled in?

Also with the code I am trying, I keep getting a error.
Compile Error: Invalid Outside Procedure

 

[jbeaucaire]

Something like this. You can add as many rows as you want in the part where we are pulling values in based on Cell Address.

Option Explicit

Sub ImportCellsFromWorkbooks()
Dim fPATH As String, fNAME As String
Dim wsOUT As Worksheet, NR As Long

Set wsOUT = ThisWorkbook.Sheets("Imported")                     'chamge this summary sheet name as needed
NR = wsOUT.Range("A" & wsOUT.Rows.Count).End(xlUp).Row + 1      'next empty row
fPATH = "N:\ENG\Intern\Packaging\"                              'don't forget the final \ in this string

fNAME = Dir(fPATH & "*.xls*")
Do While Len(fNAME) > 0
    wsOUT.Range("A" & NR).Formula = "='" & fPATH & "[" & fNAME & "]PSDS'!$G$8"      'Partnumber
    wsOUT.Range("B" & NR).Formula = "='" & fPATH & "[" & fNAME & "]PSDS'!$G$9"      'Partname
    wsOUT.Range("C" & NR).Formula = "='" & fPATH & "[" & fNAME & "]PSDS'!$G$10"     'Annual Volume
    wsOUT.Range("D" & NR).Formula = "='" & fPATH & "[" & fNAME & "]PSDS'!$E$32"     'Length
    wsOUT.Range("E" & NR).Formula = "='" & fPATH & "[" & fNAME & "]PSDS'!$G$32"     'Width
    wsOUT.Range("F" & NR).Formula = "='" & fPATH & "[" & fNAME & "]PSDS'!$K$32"     'Height
    wsOUT.Range("A" & NR & ":F" & NR).Value = wsOUT.Range("A" & NR & ":F" & NR).Value       'removes formulas
    NR = NR + 1

    fNAME = Dir
Loop

End Sub

 

[KyleRichJohn]

Thank You! I am a pretty green when it comes to this.

I am getting a "Runtime error 9, subscript out of range" on this. What am I a supposed to change?


Set wsOUT = ThisWorkbook.Sheets("Imported") 'chamge this summary sheet name as needed

 

[jbeaucaire]

Change "Imported" to whatever the sheet name is where you want the values imported into. Sheet1?

 

[sindu]

Hi Ashwin - Did you get an answer for your Question below?

I am having a same requirement as yours. Can you please share the solution if you have.

 

[Jmoz092]

I'm was going to try to alter this code to suit my needs, but I'm getting a runtime error 68 at the text highlighted in red. I can access the network drive from my laptop before and after I try to run this macro, so I don't see why I would get that run time error.

Any ideas? Is there something I'm missing?

Sub CreateSummary()


'Author:    Jerry Beaucaire, ExcelForum.com
'Date:      1/5/2011, 10/20/2014
'Summary:   Open all files in a folder and merge data (stacked) on all sheets into main wb matching the sheet names.
'           Assumes all sheets with titles exist in main book and data sheets data starts at row 2
'           If matching sheetname is not found in the master workbook, it is skipped
Dim wbData As Workbook
Dim wbMain As Workbook
Dim wsMain As Worksheet
Dim wsData As Worksheet
Dim LR As Long
Dim NR As Long
Dim fPath As String
Dim fName As String


Set wbMain = ThisWorkbook           'keeps destination focus on this workbook
                                    'if files are stored in separate directory edit fPath
fPath = "networkfilepath1:networkfilepath2:networkfilepath3:networkfilepath4:networkfilepath5" & ":"     'don't forget the final \
                                    
[COLOR=#ff0000]fName = Dir(fPath & "*.xls")         'start looping through files one at a time[/COLOR]
Application.ScreenUpdating = False  'speed up macro
On Error Resume Next                'allow macro to proceed if sheetname matches are missing


Do While Len(fName) > 0             'process one workbook at a time
    If fName <> ThisWorkbook.Name Then
        Set wbData = Workbooks.Open(fPath & fName)      'open the next resource workbook
        For Each wsData In wbData.Worksheets            'cycle through the sheets
            Set wsMain = wbMain.Sheets(wsData.Name)     'try to match the sheetnames
            If Not wsMain Is Nothing Then               'only proceed if a matching sheetname was found
                NR = wsMain.Range("A" & Rows.Count).End(xlUp).Row + 1   'next empty row
                With wsData                             'measure the used rows then copy
                    LR = .Range("A" & .Rows.Count).End(xlUp).Row
                    .Range("A2:A" & LR).EntireRow.Copy wsMain.Range("A" & NR)
                End With
                Set wsMain = Nothing
            End If
        Next wsData
        
        wbData.Close False
    End If
    
    fName = Dir                 'queue up next filename
Loop


Application.ScreenUpdating = True      'update screen, back to normal
End Sub