• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 299
  • Last Modified:

Combining Multiple Workbooks and Worksheets

Good Morning Experts,

I've looked through many of the posts and found some things similar to what I'm trying to do, but none were exact fits or entirely close. I'm not even sure if this is possible.

Details:

I have many workbooks (about 40-50 currently) that may increase or decrease in quantity.

They all exist in a main folder called Time and each workbook exists in its own sub folder.

The folder names are all different names and contain commas  EXAMPLE: Williams, Paul

The file names are also all different and contain commas   EXAMPLE: Williams, Paul

Each Workbook contains 2 sheets of importance. they are: "Labor Totals" and "EQ Totals"

I've attached a sample of what the "EQ Totals" sheet looks like in the individual workbooks.



Scenario:

I am needing to combine the data from each workbooks "Labor Totals" and "EQ Totals" sheets into one master workbook. I'd like the Labor Totals to be in a sheet called "Labor Totals" in the master workbook and   the"EQ Totals" to be in a sheet called "EQ Totals" in the master workbook. I'd also like to have the name of the workbook the respective data comes from added to the respective worksheet.

For example Cell A would have  "Williams, Paul week ending 9-10-2001" with the data from the respective datasheet, workbook, and line after it in cells b - where ever


Question: Is this possible.

Question: Can anyone assist me in writing the code as I know nothing about macros or advanced Excel.

I'd love to make this a 1000 point question but I don't think it will be allowed

Thank you in advance.

Regards,
Brian
SP32-20111013-081205.jpg
0
RedstoneIT
Asked:
RedstoneIT
  • 5
  • 3
1 Solution
 
andrewssd3Commented:
This can certainly be done, but I need a little bit more detail:
where does the week ending date come from - is this just the file name, or from somewhere else?
If all the data is to go on two sheets, would you want the Williams, Paul week ending 9-10-2001in cell A repeated for each row of the data from the individual sheet? - if you don't, filtering and totalling might be difficult
Do you want to copy all data from the EQ totals sheet the the output sheet?
It might save wasted time if you could post a sample workbook showing what you expect the output data to look like, and an input workbook with some example data (depersonalised if necessary)
Thanks
0
 
RedstoneITAuthor Commented:
I will set up a sample workbook and post it in a few. Thank you for the fast response on the idea feasibility.

0
 
RedstoneITAuthor Commented:
1.  where does the week ending date come from - is this just the file name, or from somewhere else?

A. It is just part of the file name

2. If all the data is to go on two sheets, would you want the Williams, Paul week ending 9-10-2001in cell A repeated for each row of the data from the individual sheet? - if you don't, filtering and totalling might be difficult

A. yes I want the file name the data came from in each row for filtering purposes

3. Do you want to copy all data from the EQ totals sheet the the output sheet?

A. If it is easier, then yes. The key is that week to week there may be more data or less data. (Hence the nulls)

4. It might save wasted time if you could post a sample workbook showing what you expect the output data to look like, and an input workbook with some example data (depersonalised if necessary)
Thanks

A. I've included an example time sheet.

Thank you again :)

Regards,
Brian
Smith--Bill-week-ending-4-11-200.xls
Example-Master-Workbook.xlsx
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
RedstoneITAuthor Commented:
I also forgot to mention, Can the solution be functional in both 2003 and 2007 Office ?

0
 
andrewssd3Commented:
Brian
Here is your sample with some macro code added.  I think it does what you want.  You will need to open the VBA editor (Alt-F11) and change the constant in line 18 to your file location.  You say you don't know anything about macros, so I've put in as many comments as I can, and perhaps you can start to learn. I hope it's reasonably clear how you would change it if you needed to.
You need to run the macro ImportAll from the Example_master-Workbook to get it going.

Stuart
Option Explicit

Private mwbkMaster As Excel.Workbook     ' this totals workbook
Private mrngEQOut As Excel.Range         ' next available cell for totals for EQ
Private mrngLabOut As Excel.Range        ' next available cell for totals for Labor
Private mobjFSO As Object           'object        'Scripting.FileSystemObject
    
Public Sub ImportAll()

    
    Dim shtEQTot As Excel.Worksheet
    Dim shtLabTot As Excel.Worksheet


    Dim fldMaster As Object        'Scripting.Folder
    Dim fldSub As Object        'Scripting.Folder
    Dim filData As Object        'Scripting.File
    Const cstrDataLoc As String = "c:\documents and settings\040467\desktop\Time"
    
    Set mwbkMaster = ThisWorkbook
    ' get the EQ totals sheet and find the first available row
    Set shtEQTot = mwbkMaster.Worksheets("EQ Totals")
    Set mrngEQOut = shtEQTot.UsedRange
    Set mrngEQOut = mrngEQOut.Offset(mrngEQOut.Rows.Count, 1).Resize(1, 1)
    
    ' get the Labor totals sheet and find the first available row
    Set shtLabTot = mwbkMaster.Worksheets("Labor Totals")
    Set mrngLabOut = shtLabTot.UsedRange
    Set mrngLabOut = mrngLabOut.Offset(mrngLabOut.Rows.Count, 1).Resize(1, 1)
    
    ' create the file system object
    Set mobjFSO = CreateObject("Scripting.FileSystemObject")
    ' find the master folder
    Set fldMaster = mobjFSO.GetFolder(cstrDataLoc)
    
    ' loop through all the sub folders
    For Each fldSub In fldMaster.SubFolders
        ' loop through all the files (should be only one?)
        For Each filData In fldSub.Files
            ' check it's some sort of Excel file and process it
            If LCase$(mobjFSO.GetExtensionName(filData.Name)) Like "xls*" Then
                Call ProcessFile(filData.Path)
            End If
        Next filData
    Next fldSub
    
    Set mrngEQOut = Nothing
    Set mrngLabOut = Nothing
    Set mobjFSO = Nothing
    
    MsgBox "Completed"
    
End Sub

Private Sub ProcessFile(ByVal strPath As String)
    ' called once for each workbook found
    Dim wbkIndiv As Excel.Workbook
    Dim wksCurrIn As Excel.Worksheet
    Dim rngIn As Excel.Range
    
    Dim strCaption As String            ' the name of the current input workbook
    Dim aData As Variant
    
    strCaption = mobjFSO.GetBaseName(strPath)
    
    ' open the data workbook
    Set wbkIndiv = Application.Workbooks.Open(Filename:=strPath, _
            UpdateLinks:=False, ReadOnly:=True, addtomru:=False)
    
    ' get the first sheet
    Set wksCurrIn = wbkIndiv.Worksheets("EQ Totals")
    ' get all data for this sheet into an array
    Set rngIn = wksCurrIn.UsedRange
    aData = rngIn.Value
    ' prepare the output range by making it the right size to receive the data
    Set mrngEQOut = mrngEQOut.Resize(rngIn.Rows.Count, rngIn.Columns.Count)
    ' put in the values from the input sheet
    mrngEQOut.Value = aData
    ' put in the label identifying this row
    mrngEQOut.Offset(0, -1).Resize(mrngEQOut.Rows.Count, 1).Value = strCaption
    
    
    ' get the next sheet (NB this is the same as the previous sheet - left separate
    ' in case something needs to change at a later point for one sheet
    Set wksCurrIn = wbkIndiv.Worksheets("Labor Totals")
    ' get all data for this sheet into an array
    Set rngIn = wksCurrIn.UsedRange
    aData = rngIn.Value
    ' prepare the output range by making it the right size to receive the data
    Set mrngLabOut = mrngLabOut.Resize(rngIn.Rows.Count, rngIn.Columns.Count)
    ' put in the values from the input sheet
    mrngLabOut.Value = aData
    ' put in the label identifying this row
    mrngLabOut.Offset(0, -1).Resize(mrngLabOut.Rows.Count, 1).Value = strCaption
    
    'move the output ranges on
    Set mrngEQOut = mrngEQOut.Offset(mrngEQOut.Rows.Count, 0)
    Set mrngLabOut = mrngLabOut.Offset(mrngLabOut.Rows.Count, 0)
    
    ' close the data workbook
    Application.DisplayAlerts = False
    wbkIndiv.Close xlDoNotSaveChanges
    Application.DisplayAlerts = True
    
    
End Sub

Open in new window

  Example-Master-Workbook.xlsm
0
 
RedstoneITAuthor Commented:
Andrew,

The code works perfectly.

I have one last question on this. How can I make it not ask me to save a copy of the existing workbook. I'd like it to pull the data without being prompted. If you'd prefer I can post this as a second question under Excel.

Regards,
Brian
0
 
andrewssd3Commented:
Try adding
wbkIndiv.Saved = True

Open in new window

just before the Close on line 102.  I was getting that message but I have annoying document management system which I thought was causing it.
0
 
RedstoneITAuthor Commented:
The solution works like a charm. Thank you again for the help !
0

Featured Post

Upgrade your Question Security!

Add Premium security features to your question to ensure its privacy or anonymity. Learn more about your ability to control Question Security today.

  • 5
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now