Master excel workbook from multiple excel workbooks

user12

New Member
Joined
May 16, 2019
Messages
7
I am trying to automatically transfer data from multiple workbooks into one master workbook. All workbooks are in the same folder. The data is off various column and row size and contained on only one sheet in each workbook. There are a total of 6 worksheets in the master. Example of what exactly I am trying to do is shown below. Each data set will be organized based on text found in cell C5. Any help would be greatly appreciated.

Master

Sheet1 Sheet2 Sheet3

Workbook A(C6:AA500) Workbook D(C6:AF500) Workbook Q(C6:AJ500)
Workbook C(C6:AA567) Workbook J(C6:AF567) Workbook W(C6:AJ567)


Sheet4 Sheet5 Sheet6

Workbook H(C6:AD400) Workbook S(C6:Z457) Workbook F(C6:AA500)
Workbook G(C6:AD789) Workbook N(C6:Z675) Workbook R(C6:AA567)
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
Apologies on the lack of clarity, the first time I tried to post the system logged me off because I guess i took to long to write my question so I was rushing.

In regards to automatically, I have a folder with all of the files I would like sorted into the master wkbk. Ideally, as more files are added to the folder, opening the master and running the vba will update each sheet with data the corresponds with that sheet. So I have shown each sheet having a total of two different workbooks but each one will end up having hundreds as more data is added to the folder.
 
Upvote 0
opening the master and running the vba will update each sheet

The closest thing to an answer that I can glean is the above statement. It seems to indicate that you would like a macro that runs when you open the workbook, which is easy enough to arraange. Now the acid test. In your example you show data from sheet 1 of certain workbooks being copied to specific sheets. in Post #3 you state that there will eventually be hundreds copied. What is the criteria for which workbook goes to which sheet? And will they always be the same directory as the master workbook?
 
Last edited:
Upvote 0
Again, apologies for a lack of clarity, I am quite the VBA newb. The criteria is based on text in cell C5 of each individual wkbk. For example, sheet1 of the master will contain all of the wkbks that have "Alice" in cell C5, whereas sheet2 will contain all of the wkbks that have "Larry" in cell C5 and so on. Yes they will always be the same directory as the master.
 
Upvote 0
It would be a good idea to furnish your criteria cross references to us so we can include it in the code. Otherwise, there is not way for us to tell VBA how to handle the data from the source sheets. We would need the keyword for all six sheets of the master file.
Did you confirm that you want this to run when you open the workbook?
 
Last edited:
Upvote 0
Yes I would like this to run when opening the workbook. The criteria is that the text in cell B1 of the master matches that of the text in cell C5 of the other wkbks. Not sure if it is important what the text is but it is as follows.

Larry
Alice
SOF
Coke
SWELL
Britta
 
Upvote 0
The first macro should be copied to your 'ThisWorkbook' code module.
The second code should be copied to your standard code module 1.
To access the code modules, press Alt + F11. In the Project pane at upper left of the editor window, you can double click the names of the objects to open their code window. Their names will appear in the top margin of the editor window when they are selected.
The code is triggered by opening the workbook. If you change the name of the macro from 'cpySource' you will need to change it in both macros so it will continue to work.
Code:
Private Sub Workbook_Open()
cpySource
End Sub
Code:
Sub cpySource()
Dim sh As Worksheet, fName As String, fPath As String, wb As Workbook, lr As Long, lc As Long, ssh As Worksheet
fPath = ThisWorkbook.Path & "\"
fName = Dir(fPath & "*.xl*")
    Do While fName <> ""
        If fName <> ThisWorkbook.Name Then
            Set wb = Workbooks.Open(fPath & fName)
            Select Case wb.Sheets(1).Range("C5").Value
                Case "Larry"
                    Set sh = ThisWorkbook.Sheets("Sheet1")
                Case "Alice"
                    Set sh = ThisWorkbook.Sheets("Sheet2")
                Case "SOF"
                    Set sh = ThisWorkbook.Sheets("Sheet3")
                Case "Coke"
                    Set sh = ThisWorkbook.Sheets("Sheet4")
                Case "SWELL"
                    Set sh = ThisWorkbook.Sheets("Sheet5")
                Case "Britta"
                    Set sh = ThisWorkbook.Sheets("Sheet6")
                Case Else
                    MsgBox "No Match in Cell C5 for " & wb.Name, vbExclamation, "MISMATCH"
                    wb.Close False
                    GoTo SKIP:
            End Select
            Set ssh = wb.Sheets(1)
            lc = ssh.Cells.Find("*", , xlValues, xlPart, xlByColumns, xlPrevious).Column
            lr = ssh.Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
            With ssh
                .Range("A6", .Cells(lr, lc)).Copy sh.Cells(Rows.Count, 1).End(xlUp)(2)
            End With
            wb.Close False
                End If
SKIP:
        fName = Dir
    Loop
End Sub
 
Upvote 0
I forgot to mention that the data I want from the individual workbooks always starts in cell B6 and then varies in both number of rows and columns after that. Any chance you could update on what exactly needs to be changed in your code? I am trying to understand/follow everything in it but I don't quite grasp it well enough to make edits effectively...
 
Upvote 0
Your original post indicated that you wanted to copy from Cell C6 to that last row and las colomn of the used range. To change the starting point of the upper left cell of the copy range, change the cell reference in red font below. You did not specify a destination range, so I assumed it to be column A in th master file sheets.
Code:
Sub cpySource()
Dim sh As Worksheet, fName As String, fPath As String, wb As Workbook, lr As Long, lc As Long, ssh As Worksheet
fPath = ThisWorkbook.Path & "\"
fName = Dir(fPath & "*.xl*")
    Do While fName <> ""
        If fName <> ThisWorkbook.Name Then
            Set wb = Workbooks.Open(fPath & fName) 'Opens target workbooks one at a time
            Select Case wb.Sheets(1).Range("C5").Value 'This will designate the destination sheet
                Case "Larry"
                    Set sh = ThisWorkbook.Sheets("Sheet1")
                Case "Alice"
                    Set sh = ThisWorkbook.Sheets("Sheet2")
                Case "SOF"
                    Set sh = ThisWorkbook.Sheets("Sheet3")
                Case "Coke"
                    Set sh = ThisWorkbook.Sheets("Sheet4")
                Case "SWELL"
                    Set sh = ThisWorkbook.Sheets("Sheet5")
                Case "Britta"
                    Set sh = ThisWorkbook.Sheets("Sheet6")
                Case Else   'In case no entry or bad entry is in cell C5
                    MsgBox "No Match in Cell C5 for " & wb.Name, vbExclamation, "MISMATCH" 
                    wb.Close False
                    GoTo SKIP:
            End Select
            Set ssh = wb.Sheets(1)  'Put source sheet in a variable
            lc = ssh.Cells.Find("*", , xlValues, xlPart, xlByColumns, xlPrevious).Column  'get last column of source sheet
            lr = ssh.Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row  'get last row of source sheet
            With ssh
                .Range("[COLOR=#ff0000]B6[/COLOR]", .Cells(lr, lc)).Copy sh.Cells(Rows.Count, 1).End(xlUp)(2)  'execute copy/paste
            End With
            wb.Close False
                End If
SKIP:
        fName = Dir
    Loop
End Sub
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,207
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top