Collating information from multiple separate spreadsheet into a Master Spreadsheet

[nav112]

Hi, I have three separate spreadsheets showing work shift overtime information, please see spreadsheets "Shift overtime A", "Shift overtime B", and "Shift overtime C" attached. Does anyone know a VBA code/macro which will collate the information in each of the three spreadsheets into a single spreadsheet (like the Master Shift Overtime spreadsheet attached).

[JohnTopley]

How many employees per workbook ?

[nav112]

There are 3 employees (one employee in "Shift overtime A, second in "Shift overtime B" and the third in "Shift overtime C").

[JohnTopley]

If there are only 3 employees in TOTAL (in the business) , why have a separate w/books rather all in one ??? (Confidentiality between employees?)

[nav112]

There are 1500 employees, as time goes on more employees will submit their overtime sheet, and I would like a macro button to automatically add new emloyees info as time goes on. Currently I have just give 3 employees as an example.

[JohnTopley]

Thank you: hopefully, last question: in the "Master" sheet are you expecting a "summary" for each employee i,e values in Row 46 (TOTAL) except for items like "Rate" (for example appears twice) which I assume will be taken from H15 and N15 respectively.

It is always helpful to fill in expected results as what is obvious to you may not be those responding to your request. In your overtime sheets, for example, there are no formulae for the TOTAL line.

Re macro design: the normal process is to loop through all worksheets (Employees) in a workbook, so as employees are added/deleted they will be automatically included in the "Master"

[jindon]

There are 1500 employees, as time goes on more employees will submit their overtime sheet

Try

Sub test()
    Dim myDir As String, fn As String, n As Long, cn As Object, rs As Object, ws As Worksheet, i As Long
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then myDir = .SelectedItems(1): n = 1
    End With
    If myDir = "" Then Exit Sub
    Set ws = ThisWorkbook.Sheets("sheet1")
    ws.Rows("3:" & Application.Max(ws.Cells.SpecialCells(11).Row, 3)).Clear
    Set cn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
    fn = Dir(myDir & "\*.xls*")
    Do While fn <> ""
        If n > 1 Then ws.Rows("1:2").Copy ws.Rows(n)
        For i = 1 To 4
            ws.Cells(n + 2, i) = "='" & myDir & "\[" & fn & "]sheet1'!d" & i + 6
            ws.Cells(n + 2, i + 4) = "='" & myDir & "\[" & fn & "]sheet1'!j" & i + 6
        Next
        cn.ConnectionString = "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=" & myDir & "\" & fn & ";Extended Properties=""Excel 12.0;HDR=No;"""
        cn.Open
        rs.Open "Select * From `Sheet1$H15:O` Where F1 Is Not Null;", cn, 3
        ws.Cells(n + 2, "I").CopyFromRecordset rs
        n = n + rs.RecordCount + 4: rs.Close: cn.Close
        fn = Dir
    Loop
    Set cn = Nothing: Set rs = Nothing
End Sub

[nav112]

Hi after running this code, I received a error message stating that this table contains cells that are outside the range of cells defined in this spreadsheet. I am not entirely sure why this error message appear, when looking at the spreadsheets that I am trying to collate the data from, they all appear within the range specified within the VBA? can anyone assist.

[jindon]

If you are getting such error, don't use it and wait for someone else.