locked
How to merge data from many workbooks into one table? RRS feed

  • Question

  • Hello everyone,

     

    I am trying to make a VBA macro, but am lost. I found several interesting macros at the internet, but I can’t compile them correctly.

    Here’s the situation:

    Our managers use an excel file to collect attendance of their employees.

    I prepared a file, containing 2 sheets:

    - 1<sup>st</sup> sheet contains reference data (list of employees, their serial numbers, departments, …)

    - 2<sup>nd</sup> sheet contains empty table, starting on cell B6, with 6 columns to be filled-in (employee name, serial number, department, date, starting time, ending time)

     

    One file would be considered as Master file, owned by each manager. Every manager will have the file saved in some folder in his/her computer. The folder will not be the same for all the managers.

    Managers will distribute this file to their employees to fill in the attendance and then the files from employees will be collected by each manager. They will keep the master file and collected files in one folder.

    I would need a macro to merge the data from collected files, from 2nd sheet, from cell B6 to G136 to the Master file, as well to 2nd sheet, to the range B6 till Gxxx, one employee below another, until all the files are in Master file.

     

    Could you please help with this?

     

    Thank you.

    Wednesday, July 18, 2012 1:46 PM

Answers

  • Put this code into the Master workbook, in a standard code module, and run the macro. When prompted, select all the files that you want to grab data from.  I have assumed that column B is filled for any line with data.

    Bernie

    Sub Consolidate()
    Dim FileArray As Variant
    Dim i As Integer
    Dim myBook As Workbook

    FileArray = Application.GetOpenFilename(MultiSelect:=True)
    If IsArray(FileArray) Then
        For i = LBound(FileArray) To UBound(FileArray)
            Set myBook = Workbooks.Open(FileArray(i))
            myBook.Worksheets(2).Range("B6:G136").Copy _
                ThisWorkbook.Worksheets(2).Cells(Rows.Count, 2).End(xlUp)(2)
            myBook.Close False
        Next i
    End If

    ThisWorkbook.SaveAs Application.GetSaveAsFilename
    End Sub


    HTH, Bernie

    • Marked as answer by Salalajka Thursday, July 26, 2012 12:03 PM
    Wednesday, July 18, 2012 4:44 PM
  • You can select all the files at once, since multi-select is enabled.

    HTH, Bernie

    • Marked as answer by Salalajka Thursday, July 26, 2012 12:03 PM
    Wednesday, July 25, 2012 3:14 PM
  • Hi Sailaja,

    If you want, you can try with this...

    Place a command button on excel spread sheet  and name it as "CMDS" by right click on button and select "Assign Macro"

    a seperate window appears (Module 1)

    Copy and paste the following code there...  when you click on the command button, a file open dialog box is displayed., since multi select is true, you can select any number  of files that need to be imported.

    Dim srcStartCell As String

    Sub cmds()
    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)

    srcStartCell = "A2"
    Dim vrtSelectedItem As Variant
    Range("A2").Select

    With fd
        .AllowMultiSelect = True
        .Title = "Select Excel Files..."
        If .Show = -1 Then
            For Each vrtSelectedItem In .SelectedItems
                Debug.Print "The path is: " & vrtSelectedItem
                ImportWorksheet vrtSelectedItem, srcStartCell
            Next vrtSelectedItem
        Else
        End If
    End With
    Set fd = Nothing
    End Sub


    Sub ImportWorksheet(strWorkSheet As Variant, srcStartCell As String)
    Dim startCell As String
    Dim endCell As String

    startCell = "A2"
        Sheets("Sheet1").Select
        TabName = "Sheet1"
        controlfile = ActiveWorkbook.Name
        Workbooks.Open strWorkSheet
        ActiveSheet.Name = TabName
       
        ActiveSheet.Range(startCell).Activate
        ActiveSheet.Range(startCell).Select
       
        ActiveCell.End(xlDown).Select
        ActiveCell.End(xlToRight).Select
        endCell = ActiveCell.Address
       
        Range(startCell, endCell).Copy
      
        ActiveWorkbook.Close False
       
        Windows(controlfile).Activate
        ActiveSheet.Paste
        ActiveCell.End(xlDown).Select
        ActiveCell.Offset(1, 0).Select
        srcStartCell = ActiveCell.Address
    '    Workbooks("Cogs.xls").Worksheets("Sheet1").Activate
    End Sub


    Love the Love that Loves the Love and Hate the Love that Loves the Hate.


    • Edited by Repath Athyala Friday, July 27, 2012 1:43 PM additional content
    • Proposed as answer by Repath Athyala Tuesday, July 31, 2012 2:29 PM
    • Marked as answer by Salalajka Monday, August 6, 2012 1:58 PM
    Friday, July 27, 2012 1:42 PM

All replies

  • Put this code into the Master workbook, in a standard code module, and run the macro. When prompted, select all the files that you want to grab data from.  I have assumed that column B is filled for any line with data.

    Bernie

    Sub Consolidate()
    Dim FileArray As Variant
    Dim i As Integer
    Dim myBook As Workbook

    FileArray = Application.GetOpenFilename(MultiSelect:=True)
    If IsArray(FileArray) Then
        For i = LBound(FileArray) To UBound(FileArray)
            Set myBook = Workbooks.Open(FileArray(i))
            myBook.Worksheets(2).Range("B6:G136").Copy _
                ThisWorkbook.Worksheets(2).Cells(Rows.Count, 2).End(xlUp)(2)
            myBook.Close False
        Next i
    End If

    ThisWorkbook.SaveAs Application.GetSaveAsFilename
    End Sub


    HTH, Bernie

    • Marked as answer by Salalajka Thursday, July 26, 2012 12:03 PM
    Wednesday, July 18, 2012 4:44 PM
  • You can use Ron's marge addin http://www.rondebruin.nl/merge.htm

    or another solutions signed as more information below.


    Oskar Shon, Office System MVP

    Press if Helpful; Answer when a problem solved

    Wednesday, July 18, 2012 8:33 PM
    Answerer
  •  

    Hi Bernie,

    thank you for your promt reply! I tried the code.

    I opened Master file and put the code there.
    It prompts me to open a file I would like to copy data from. Then it asks me whether I want to save changes to the opened file.

    I click NO. Then it prompts me to Save Master file As.
    When I click Cancel, it creates new file called FALSE.xls
    When I click Save, original Master file is resaved and macro is finnished.

    Then I have to run the macro again since the begining.

    I was thinking whether it is possible to consolidate all the inputs that are saved in the same folder as the master file automatically, without macro asking to chose which file to open. There will be some 30 files to consolidate and it might by quite time consuming to chose every time which file to consolidate.

    Thanks.

    Wednesday, July 25, 2012 9:11 AM
  • Hi Oskar,

    the addin looks quite interesting, for sure I will try it.

    Thanks a lot!

    Wednesday, July 25, 2012 9:12 AM
  • My (Ron's) welcome ;]

    Oskar Shon, Office System MVP

    Press if Helpful; Answer when a problem solved

    Wednesday, July 25, 2012 10:43 AM
    Answerer
  • You can select all the files at once, since multi-select is enabled.

    HTH, Bernie

    • Marked as answer by Salalajka Thursday, July 26, 2012 12:03 PM
    Wednesday, July 25, 2012 3:14 PM
  • Hi Bernie,

    seems it might work..

    Thank you very very much :)

    Thursday, July 26, 2012 12:03 PM
  • Hi Bernie,

    this macro is awesome!

    However even it says "myBook.Close Savechanges:=False"
    after opening each of the files, "Would you like to save changes?" window pops-up.
    I also tried to change this command a bit, but nothing works.

    Thursday, July 26, 2012 2:27 PM
  • Use Application.DisplayAlerts = False  and then True, as in:

    Sub Consolidate2()
    Dim FileArray As Variant
    Dim i As Integer
    Dim myBook As Workbook

    FileArray = Application.GetOpenFilename(MultiSelect:=True)

    Application.DisplayAlerts = False

    If IsArray(FileArray) Then
        For i = LBound(FileArray) To UBound(FileArray)
            Set myBook = Workbooks.Open(FileArray(i))
            myBook.Worksheets(2).Range("B6:G136").Copy _
                ThisWorkbook.Worksheets(2).Cells(Rows.Count, 2).End(xlUp)(2)
            myBook.Close False
        Next i
    End If

    Application.DisplayAlerts = True

    ThisWorkbook.SaveAs Application.GetSaveAsFilename
    End Sub



    HTH, Bernie

    Thursday, July 26, 2012 2:39 PM
  • It didn't help.

    "Do you want to save changes?" windows still pop-up.

    Thursday, July 26, 2012 3:14 PM
  • Sorry - it has always worked for me, and still does.

    Do you have both macros in the workbook, and did you run the newest version?


    HTH, Bernie

    Thursday, July 26, 2012 3:24 PM
  • I put the latest macro you sent to the workbook. And the windows are still popping-up...
    I guess I can live with that :)

    You helped me soo much.

    I really appreciate.

    Thank you again!

    Thursday, July 26, 2012 3:40 PM
  • Hi Sailaja,

    If you want, you can try with this...

    Place a command button on excel spread sheet  and name it as "CMDS" by right click on button and select "Assign Macro"

    a seperate window appears (Module 1)

    Copy and paste the following code there...  when you click on the command button, a file open dialog box is displayed., since multi select is true, you can select any number  of files that need to be imported.

    Dim srcStartCell As String

    Sub cmds()
    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)

    srcStartCell = "A2"
    Dim vrtSelectedItem As Variant
    Range("A2").Select

    With fd
        .AllowMultiSelect = True
        .Title = "Select Excel Files..."
        If .Show = -1 Then
            For Each vrtSelectedItem In .SelectedItems
                Debug.Print "The path is: " & vrtSelectedItem
                ImportWorksheet vrtSelectedItem, srcStartCell
            Next vrtSelectedItem
        Else
        End If
    End With
    Set fd = Nothing
    End Sub


    Sub ImportWorksheet(strWorkSheet As Variant, srcStartCell As String)
    Dim startCell As String
    Dim endCell As String

    startCell = "A2"
        Sheets("Sheet1").Select
        TabName = "Sheet1"
        controlfile = ActiveWorkbook.Name
        Workbooks.Open strWorkSheet
        ActiveSheet.Name = TabName
       
        ActiveSheet.Range(startCell).Activate
        ActiveSheet.Range(startCell).Select
       
        ActiveCell.End(xlDown).Select
        ActiveCell.End(xlToRight).Select
        endCell = ActiveCell.Address
       
        Range(startCell, endCell).Copy
      
        ActiveWorkbook.Close False
       
        Windows(controlfile).Activate
        ActiveSheet.Paste
        ActiveCell.End(xlDown).Select
        ActiveCell.Offset(1, 0).Select
        srcStartCell = ActiveCell.Address
    '    Workbooks("Cogs.xls").Worksheets("Sheet1").Activate
    End Sub


    Love the Love that Loves the Love and Hate the Love that Loves the Hate.


    • Edited by Repath Athyala Friday, July 27, 2012 1:43 PM additional content
    • Proposed as answer by Repath Athyala Tuesday, July 31, 2012 2:29 PM
    • Marked as answer by Salalajka Monday, August 6, 2012 1:58 PM
    Friday, July 27, 2012 1:42 PM
  • Hi Repath Athyala,

    thank you very much for your macro!

    Monday, August 6, 2012 1:57 PM
  • Hi Bernie,

    I found a solution:

    'Turn off screen flashing
        With Application
            .EnableEvents = False
            .ScreenUpdating = False
        End With

    'Restore screen updates
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With

    Monday, August 6, 2012 2:53 PM
  • Hi Bernie,

    once more I would like to thank you very much for the awesome consolidation macro.

    I was wondering, can it be changed so that the data copied from collected files and merged to Master file are pasted as values, without any formulas?

    I tried several options but nothing is working. The data are still pasted including formulas.

    Here is your code:

    Sub Consolidate2()
    Dim FileArray As Variant
    Dim i As Integer
    Dim myBook As Workbook

    FileArray = Application.GetOpenFilename(MultiSelect:=True)

    Application.DisplayAlerts = False

    If IsArray(FileArray) Then
        For i = LBound(FileArray) To UBound(FileArray)
            Set myBook = Workbooks.Open(FileArray(i))
            myBook.Worksheets(2).Range("B6:G136").Copy _
                ThisWorkbook.Worksheets(2).Cells(Rows.Count, 2).End(xlUp)(2)
            myBook.Close False
        Next i
    End If

    Application.DisplayAlerts = True

    ThisWorkbook.SaveAs Application.GetSaveAsFilename
    End Sub

    Could you please help with this?

    Thank you.

    Friday, April 5, 2013 10:42 AM