none
Consolidation RRS feed

  • Question

  • Sir/Madam,

    I have 12 monthly workbook (January to December) for each year stored in a folder.The workbooks contain 25 sheets. Out of which, I want to  consolidate data of sheets named "Purchase',"Sales","customers","enquirers".So, I would like to create a macro to create a workbook which has sheets named "Purchase',"Sales","customers","enquirers" and consolidate data from similarly named worksheets in the monthly books.

    Please help.


    ஜெ.இரவிச்சந்திரன்

    Friday, January 12, 2018 9:14 AM

All replies

  • Put this macro into a standard codemodule of a new workbook and save that workbook as a macro-enabled .xlsm in the same folder with your 12 workbooks. Then run the macro, which will create a file that I have named 

    Consolidated data.xlsx

    in that same folder. The data will be shifted over by one column and column A of each of those sheets will have the file name of the data source - which depends on column A of the source sheets being filled   If you have and problems post back.

    Bernie

    Sub ConsolidateFiles()
        
        Dim v As Variant
        Dim n As Variant
        Dim strPath As String
        Dim wkbkT As Workbook
        Dim strF As String
        Dim wkbkNew As Workbook
        Dim i As Integer
        
        With Application
            .DisplayAlerts = False
            .EnableEvents = False
            .ScreenUpdating = False
        End With
        
        n = Array("Purchase", "Sales", "Customers", "Enquirers")
        
        strPath = ThisWorkbook.Path & "\"
        
        strF = Dir(strPath & "*.xlsx")
        
        Set wkbkNew = Workbooks.Add
        
        For i = 1 To UBound(n)
            wkbkNew.Worksheets.Add
        Next i
        
        i = 0
        For Each v In n
            i = i + 1
            wkbkNew.Worksheets(i).Name = v
            wkbkNew.Worksheets(i).Range("A1").Value = "Workbook source"
            wkbkNew.Worksheets(i).Range("B1").Value = "Data"
        Next v
        
        While strF <> ""
            Set wkbkT = Workbooks.Open(strPath & strF)
            For Each v In n
                wkbkT.Worksheets(v).UsedRange.Copy
                With wkbkNew.Worksheets(v)
                    .Cells(.Rows.Count, 2).End(xlUp)(2).PasteSpecial xlPasteValuesAndNumberFormats
                    .Range(.Cells(.Rows.Count, "A").End(xlUp).Offset(1), .Cells(.Rows.Count, "B").End(xlUp).Offset(0, -1)).Value = strF
                End With
            Next v
            wkbkT.Close
            strF = Dir()
        Wend
        
        wkbkNew.SaveAs strPath & "Consolidated data.xlsx", 51
        
        With Application
            .DisplayAlerts = True
            .EnableEvents = True
            .ScreenUpdating = True
        End With
        
    End Sub

    Friday, January 12, 2018 4:11 PM
  • Hello rjagathe,

    Has your original issue been resolved? If it has, I would suggest you mark the helpful reply as answer or provide your solution and mark as answer to close this thread. If not, please feel free to let us know your current issue.

    Best Regards,

    Terry



    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Tuesday, January 16, 2018 1:22 AM
  • Dear bernie,

    The macro works fine.But, it appends  all 12 months' data  one below another .I want something different.

    I want that all 12 months' data to be   added on on the other which we usually do by following   "Paste-Special: "values only"+"add" menus.

    Moreover, I want error message to be displayed, if any of the sheet in a month is missing. The error message should be skipped by user and proceeded to complete remaining action.

    Thanks,

    Regards,

    Ravichandran J


    ஜெ.இரவிச்சந்திரன்

    Tuesday, January 30, 2018 11:47 AM
  • Try it this way then:

    Sub ConsolidateFiles2()
        
        Dim v As Variant
        Dim n As Variant
        Dim strPath As String
        Dim wkbkT As Workbook
        Dim strF As String
        Dim wkbkNew As Workbook
        Dim i As Integer
        
        With Application
            .DisplayAlerts = False
            .EnableEvents = False
            .ScreenUpdating = False
        End With
        
        n = Array("Purchase", "Sales", "Customers", "Enquirers")
        
        strPath = ThisWorkbook.Path & "\"
        
        strF = Dir(strPath & "*.xlsx")
        
        Set wkbkNew = Workbooks.Add
        
        For i = 1 To UBound(n)
            wkbkNew.Worksheets.Add
        Next i
        
        i = 0
        For Each v In n
            i = i + 1
            wkbkNew.Worksheets(i).Name = v
        Next v
        
        On Error GoTo NoSheet
        
        While strF <> ""
            Set wkbkT = Workbooks.Open(strPath & strF)
            For Each v In n
                wkbkT.Worksheets(v).UsedRange.Copy
                With wkbkNew.Worksheets(v)
                    .Cells(1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd, SkipBlanks:=False
                End With
            Next v
    DoNextSheet:
            wkbkT.Close
            strF = Dir()
        Wend
        
        wkbkNew.SaveAs strPath & "Consolidated data.xlsx", 51
        
        With Application
            .DisplayAlerts = True
            .EnableEvents = True
            .ScreenUpdating = True
        End With
        Exit Sub
    NoSheet:
        MsgBox "Sheet """ & v & """ does not exist in file " & strF
        Resume DoNextSheet
        
    End Sub

    Tuesday, January 30, 2018 1:58 PM
  • Thank You


    ஜெ.இரவிச்சந்திரன்

    Wednesday, July 11, 2018 11:30 AM