consolidate data from multiple workbooks with multiple sheets.

[Viraj Shirsat]

Hi guys,
We receive 7 different reports which are copy pasted in a single workbook in different sheets(as per reports name), and each of the report is allotted among 4 members and processed, Such that all 4 have to work on all the 7 reports. At the end of the day I need to collate the 4 processed files and then make it a single file again and then save it. There are days when we don't receive all the 7 reports(4 are daily reports & 3 are weekly reports). Hence a recorded macro doesn't work properly. I want the macro to collate the data from all the 4 workbooks into a single workbook, and paste it one below other in respective sheets as per the reports name.

 

[bsquad]

I think it would be helpful to explain it again, I get there are 7 total possible reports, 4 are daily, 3 are weekly; from the 7 reports, in the MasterWorkbook these there are 7 sheets, whose tab name corresponds with the report name. But you lost me about the comment is allotted among 4 members and processed. Are you basically saying it needs to be aggregated?
OR
if you have your current code that would be helpful as well

 

[Viraj Shirsat]

sorry for confusion, lets go step by step. We are a team of 4 members who work on this reports. At the start of the day we receive reports that need to be processed for the day. The maximum number of reports that can be received is 7.We get this reports at the start of the day in different excel sheets, they are collated in a single workbook in different sheets, filtered for XYZ reasons and the remaining are allotted among 4 of us, so that each person gets to work on each report. At the end of the day we again collate the processed sheets from each one of us, and then paste one below other in their respective sheets so that we can send it to the client. I want to create a macro that will collate the data at the end of the day. The problems that I am stuck is that there are days when we have to work only on 3 of the reports. So how to setup the code that wont show any error if some of the sheets are missing.

Thanks in advance.

 

[bsquad]

so basically you want a Master sheet to send to the client? - I am still getting a little confused when you say you want to "collate it, and the paste one below the other in their respective sheets" pasting one below the other is essentially collating>>unless you mean it need to do something in the source file/raw reports prior to it getting imported into the Master sheet.

Also, this Master sheet, when you say respective sheets - do you mean in the Master you have 7 different tabs? (one for each report), or do you mean one sheet >>"and then paste one below the other"

 

[Viraj Shirsat]

yes i want a master sheet to send it to client. And yes My master file should have 7 sheets for each reports.

 

[bsquad]

alright, I think I get what you are saying.
A couple things to note:
-when selecting the files to import, the filter is set on .xlsx, and xlsm, if you are using anything < Excel 2013 you'll have to change it to I believe .xls
-when you select the files to import, its a multi select; so you hold down CTRL and select the import files (if you didn't already know that)
--the logic for import goes by numeric then alpha and not in the order you select the files - but that shouldn't matter in your case.
-this will account for any blank cells in your report - on the import file it select cell A1 then finds the last cell of the last column occupied and makes that area its range, so any blank cells in between will be accounted for.
-this code matches by sheet name, so be sure your MasterWorkbook sheet names match the sheet names in your import workbooks

Paste the code below in the VBE of the Master Workbook
Let me know if you have issues

Sub Master()
    Dim Imports As Worksheet
    Dim MasterSheet As Worksheet
    Dim OpenImportWorkbook As Variant
    Dim ImportWorkbook As Workbook
    Dim MasterWorkbook As Workbook
        Set MasterWorkbook = ThisWorkbook
    Dim i As Integer
    Dim x As Integer
    Dim LR As Integer
    Dim ER As Long
    Dim LC As Long


        Application.DisplayAlerts = False
        Application.AskToUpdateLinks = False
        Application.ScreenUpdating = False
        ChDir ActiveWorkbook.Path
        OpenImportWorkbook = Application.GetOpenFilename(filefilter:="Excel Workbooks(*.xlsx; *xlsm,*.xlsx;*xlsm", _
                            Title:="Import File Select", MultiSelect:=True)
                            On Error Resume Next
            For i = LBound(OpenImportWorkbook) To UBound(OpenImportWorkbook)
            Set ImportWorkbook = Workbooks.Open(OpenImportWorkbook(i))
                For x = 1 To MasterWorkbook.Worksheets.Count
                     Set Imports = Nothing
                        On Error Resume Next
                        Set Imports = ImportWorkbook.Worksheets(MasterWorkbook.Worksheets(x).Name)
                        On Error GoTo 0
                        If TypeName(Imports) <> "Nothing" Then
                            LC = Imports.Range("A1").SpecialCells(xlCellTypeLastCell).Column
                            ER = Imports.Range("A1").SpecialCells(xlCellTypeLastCell).Row
                           Imports.Range(Cells(1, 1), Cells(ER, LC)).Copy
                                If MasterWorkbook.Worksheets(x).Cells(1, 1).Value = "" Then
                                    With MasterWorkbook.Worksheets(x)
                                        .Cells(1, 1).PasteSpecial Paste:=xlPasteAll
                                    End With
                                    Else
                                    With MasterWorkbook.Worksheets(x)
                                        LR = ThisWorkbook.Worksheets(x).Cells(Rows.Count, "A").End(xlUp).Row
                                        .Cells(LR, 1).Offset(1, 0).PasteSpecial Paste:=xlPasteAll
                                    End With
                                    Application.CutCopyMode = False
                                End If
                        End If
                Next x
                ActiveWorkbook.Close savechanges:=False
            Next i
        Application.DisplayAlerts = True
        Application.AskToUpdateLinks = True
        Application.ScreenUpdating = True




End Sub