Importing data from multiple workbooks to one sheet in master workbook

[kakiebos]

Good day all.

I'm busy to automate some of our time sheets and overtime reporting. Each employee completes his/her own timesheet in a Excel Spreadsheet. Some of this information is then merged into a monthly summary. At the end of the month the employee is using a button, with a Macro, to print the summary for approval by the manager. Together with this creation of the PDF document, a additional Excel spreadsheet is created with only the totals of the summary sheet. This spreadsheet is then sent to the admin office via email.

The admin person will then receive spreadsheets from all the employees and this is then imported into a master file that is then sent to head office for payroll.

At this stage, the code that I have will import the data one spreadsheet at a time. I would like to modify my code to multi select all the spreadsheets for the month at once and all the information is then imported into the master file.

Probably with something like a array or loop. I'm not sure and not that familiar with VBA yet.

This is the code that I currently have.

Sub Import_Monthly_OverTime()
    
    Application.ScreenUpdating = False


    Dim FileToOpen As Variant
    Dim OpenBook As Workbook, shAllBranch As Worksheet
    Dim r As Long
    
    r = Range("A6").End(xlDown).Row + 1


    FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", Filefilter:="Excel Files (*.xls*),*xls*")
'    FileToOpen = Application.GetOpenFilename(Filefilter:="Excel Files (*.xlsx), *.xlsx", Title:="Select Workbook to Import", MultiSelect:=True)
    
    If FileToOpen <> False Then
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
        OpenBook.Sheets(1).Range("A2:L2").Copy
        ThisWorkbook.Worksheets("Overtime Sheet").Range("A" & r).PasteSpecial xlPasteValues
        OpenBook.Close False
    End If
    Range("B11").Select
    
    Application.ScreenUpdating = True
  
End Sub

Any help will really be appreciated.

 

[dmt32]

Hi,
have a look that this article by Ron de Bruin which may do what you want.:https://docs.microsoft.com/en-us/pr...007/cc837974(v=office.12)?redirectedfrom=MSDN

As a thought, if all employees are saving their timesheets to a shared network folder then you could consider having their data write directly to your master workbook. This approach would negate the need to undertake a consolidation exercise each time.


Dave

 

[kakiebos]

Thanks, I will have a look.
Unfortunately a network folder is not an option, as some of the people are working in remote areas that is not linked to the branch office. Some of them doesn't even always have internet access.

 

[kakiebos]

Hi,
have a look that this article by Ron de Bruin which may do what you want.:https://docs.microsoft.com/en-us/pr...007/cc837974(v=office.12)?redirectedfrom=MSDN

As a thought, if all employees are saving their timesheets to a shared network folder then you could consider having their data write directly to your master workbook. This approach would negate the need to undertake a consolidation exercise each time.


Dave

Dave, I had a look at the link you provided. It looks fascinating, but it is WAY over my experience range. I only started out with VBA about 6 months ago. If that long.
Any suggestions on modifying my existing code to be able to multi select files and importing it to my current workbook in the specified range would be appreciated.

 

[dmt32]

Dave, I had a look at the link you provided. It looks fascinating, but it is WAY over my experience range. I only started out with VBA about 6 months ago. If that long.
Any suggestions on modifying my existing code to be able to multi select files and importing it to my current workbook in the specified range would be appreciated.

Hi,
untested but see if this update to your current code helps

Sub Import_Monthly_OverTime()
    Dim FileToOpen As Variant
    Dim OpenBook As Workbook
    Dim i As Integer


    FileToOpen = Application.GetOpenFilename(Filefilter:="Excel Files (*.xlsx), *.xlsx", _
                                             Title:="Select Workbook(s) to Import", _
                                             MultiSelect:=True)
    If VarType(FileToOpen) = vbBoolean Then Exit Sub
    
    Application.ScreenUpdating = False
    If IsArray(FileToOpen) Then
        For i = LBound(FileToOpen) To UBound(FileToOpen)
            Set OpenBook = Application.Workbooks.Open(FileToOpen(i))
            CopyFile OpenBook
        Next i
    Else
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
        CopyFile OpenBook
    End If
    
    Application.ScreenUpdating = True
  
End Sub


Sub CopyFile(FileToCopy As Object)
        Dim r As Long
        FileToCopy.Sheets(1).Range("A2:L2").Copy
         With ThisWorkbook.Worksheets("Overtime Sheet")
             r = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
            .Range("A" & r).PasteSpecial xlPasteValues
         End With
        FileToCopy.Close False
        Set FileToCopy = Nothing
End Sub

Dave

 

[kakiebos]

Hi Dave.

Thank you so much. It is working almost perfectly. I have one, hopefully small, problem. Your code assumes that the destination page is blank. Unfortunately it is a document that needs to be signed by a couple of people. Those names and signature blocks is below the range where the data is imported to.

In my case the first row of entries is in row 8. Hence my original code to get r (Row number) was

    r = Range("A6").End(xlDown).Row + 1

I tried to modify your code to what I believe to get r. When I run that code, I get a 1004 error. I have commented at the line where the code is stopping with the error message. I have also only commented your line of code out and inserted my line of code. Perhaps I'm doing something wrong, or did not add something important.

    Sub CopyFile(FileToCopy As Object)        Dim r As Long
        FileToCopy.Sheets(1).Range("A2:L2").Copy
         With ThisWorkbook.Worksheets("Overtime Sheet")
             r = Range("A6").End(xlDown).Row + 1
'             r = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
            Range("A" & r).PasteSpecial xlPasteValues   'Method 'Range' of object'_Global' failed.
         End With
        FileToCopy.Close False
        Set FileToCopy = Nothing

Once again, thank you for your assistance.

 

[dmt32]

hi,
if you want to have variable r start at a particular value then just add the additional line of code shown in red

Sub CopyFile(FileToCopy As Object)
        Dim r As Long
        FileToCopy.Sheets(1).Range("A2:L2").Copy
         With ThisWorkbook.Worksheets("Overtime Sheet")
             r = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
             If r < 8 Then r = 8
            .Range("A" & r).PasteSpecial xlPasteValues
         End With
        FileToCopy.Close False
        Set FileToCopy = Nothing
End Sub

Dave