Copy data from variable number of workbooks into a master file in loop

[patsdavixen]

Hi,

I have a folder with the path "C:\A\Consolidated".
This folder contains the master file. There are also folders within the Consolidated Folder that are differentiated by dates - YYYYMMDD.
The date folders contain identical workbooks that are differentiated only by employee name. The number of employee workbooks in each date folder may vary in number because the employee may not update their workbook on a daily basis but the master file needs to be consolidated on a daily basis.

I would like to create a macro that opens the master file and then asks the user which date they want to consolidate. Based on the user’s response, the path will become "C:\A\Consolidated\YYYYMMDD”.
The macro should then proceed to open each employee workbook in the date folder and copy data from the sheet entitled “Individual” from A:AI (rows are variable but will always start with row 2) and paste the data in the master file on the sheet entitled “Consolidated” at the end of variable rows (A:AI is constant but the rows will be variable and may not start at row 2).
Once this is done the macro should close the employee workbook and continue to copy and paste from the remaining employee workbooks in loop until all workbooks have been consolidated in to the master file.
The master file must then be saved in "C:\A\Consolidated" with the new date of the file.

Could someone please help me with this as the number of workbooks to loop through are variable and the names are variable? Also the path to the employee workbooks are variable.

Thank you,
Pat

 

[JLGWhiz]

The assumptions are:
1. The master workbook will contain the code and therefore will be open at the beginning of the process.
2. The master file latyout is identical to the employee workbooks' layout.
3. All employee workbooks for a specific date are to be copied to the master file.

The code is untested, so post back with details of any error messages so corrections can be made if needed.

Sub upDtMstr()
Dim wbM As Workbook, sh As Worksheet, mSh As Worksheet, wb As Workbook, sPath As String, fName As String
Set wbM = ThisWorkbook
Set mSh = wbM.Sheets("Consolidated")
fldr = InputBox("PLEASE ENTER THE FOLDER IN YYYYMMDD FORMAT", "FOLDER TO UPDATE")
sPath = "ThisWorkbook.Path & "\" & fldr & " \ ""
fName = Dir(sPath & "*.xl*")
    Do While fName <> ""
        Set wb = Workbooks.Open(fName)
        Set sh = wb.Sheets("Individual")
        lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
        sh.Range("A1:AI" & lr).Copy mSh.Cells(Rows.Count, 1).End(xlUp)(2)
        wb.Close False
        fName = Dir
    Loop
wbM.Close True
Set wbM = Nothing
Set mSh = Nothing
Set wb = Nothing
Set sh = Nothing
End Sub

 

[patsdavixen]

Hi JLGWhiz,

Thank you for replying to my post.
The macro has an error pop-up at sPath = "ThisWorkbook.Path & "\" & fldr & " \ ""
I couldn't figure out why that was because the path that the code identifies seems to be accurate.
The error pop-up says Run time error # 13, Type mismatch.

Could you please help me fix it? Also please let me know if you need additional information.

Thanks,
Pat

 

[JLGWhiz]

Hi JLGWhiz,

Thank you for replying to my post.
The macro has an error pop-up at sPath = "ThisWorkbook.Path & "\" & fldr & " \ ""
I couldn't figure out why that was because the path that the code identifies seems to be accurate.
The error pop-up says Run time error # 13, Type mismatch.

Could you please help me fix it? Also please let me know if you need additional information.

Thanks,
Pat

Don't know where they came from, but remove the outer quotation marks. Here is what the line should lookd like

sPath = ThisWorkbook.Path & "\" & fldr & "\"

 

[patsdavixen]

Hi, I tried the macro without the extra "" and the error stopped poping up. But the macro simply closes the master file.
I used the "step into (F8)" function to see what it was doing and it just jumps from fName = Dir(sPath & "*.xl*") to wbM.Close True and closes the master file.

Do you have any ideas on how the macro can run through the loop?

 

[JLGWhiz]

Yes, I found a couple of glitches. This should run OK.

Sub upDtMstr2()
Dim wbM As Workbook, sh As Worksheet, mSh As Worksheet, wb As Workbook, sPath As String, fName As String
Set wbM = ThisWorkbook
Set mSh = wbM.Sheets("Consolidated")
fldr = InputBox("PLEASE ENTER THE FOLDER IN YYYYMMDD FORMAT", "FOLDER TO UPDATE")
sPath = ThisWorkbook.Path & "\" & fldr & "\"
fName = Dir(sPath & "*.xl*")
    Do While fName <> ""
        Set wb = Workbooks.Open(sPath & fName)
        Set sh = wb.Sheets("Individual")
        lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
        sh.Range("A1:AI" & lr).Copy mSh.Cells(Rows.Count, 1).End(xlUp)(2)
        wb.Close False
        fName = Dir
    Loop
Set wbM = Nothing
Set mSh = Nothing
Set wb = Nothing
Set sh = Nothing
sbM.Close True
End Sub

 

[patsdavixen]

Thank you for all your help. This code worked perfectly

 

[JLGWhiz]

You are welcome.
Regards, JLG

 

[patsdavixen]

Hi,

I'm not sure if I should post this question here or start a new thread.
The macro that was created in this post works perfectly, the only problem I have is that I tried to make it an add-in and it does not work anymore. The error that pops up is "Run-time error #9, Subscript out of range" and highlights this part of the macro "Set mSh = wbM.Sheets("Consolidated")"
My guess is that the macro can only work when it is in a module in the master workbook. Could someone please either help me figure out a way to have the macro run as an add-in or help me create a macro in the form of an add-in that will create a module in the master workbook insert the code, run it in the master workbook and then remove the module whenever the addin button is clicked. I've included my final code below:

Sub FinalConsolidation()
Dim wbM As Workbook, sh As Worksheet, mSh As Worksheet, wb As Workbook, sPath As String, fName As String
Set wbM = ThisWorkbook
Set mSh = wbM.Sheets("Consolidated")
fldr = InputBox("PLEASE ENTER THE FOLDER IN YYYYMMDD FORMAT", "FOLDER TO UPDATE")
sPath = ThisWorkbook.Path & "\" & fldr & "\"
fName = Dir(sPath & "*.xl*")
    Do While fName <> ""
        Set wb = Workbooks.Open(sPath & fName)
        Set sh = wb.Sheets("Individual Tracker")
        With Sheets("Individual Tracker")
        lastCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        .Range("A2", .Cells(lastRow, lastCol)).Copy
    End With
    ActiveWindow.ActivateNext
    
    With Sheets("Consolidated")
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        If lastRow = 1 And .Cells(1) = "" Then lastRow = 0
        .Cells(lastRow + 1, "A").PasteSpecial Paste:=xlPasteValues, _
            Operation:=xlNone, SkipBlanks:=False, Transpose:=False
           
    End With
    Application.CutCopyMode = False
        wb.Close False
        fName = Dir
    Loop
    myFilename = "Tracker" & " " & fldr & "_v1.xls"
    sPath = ThisWorkbook.Path
    ActiveWorkbook.SaveAs Filename:= _
    sPath & "\" & myFilename, _
    FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
    ReadOnlyRecommended:=False, CreateBackup:=False
    ActiveWorkbook.Close
Set wbM = Nothing
Set mSh = Nothing
Set wb = Nothing
Set sh = Nothing

End Sub

Thank you,
Pat

 

[Andrew Poulsom]

Continued here:

http://www.mrexcel.com/forum/excel-...erts-runs-removes-module-active-workbook.html