Importing data from multiple workbooks to one sheet in master workbook

kakiebos

Board Regular
Joined
Jun 10, 2018
Messages
62
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.

Code:
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.
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
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
 
Upvote 0
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.
 
Upvote 0
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.
 
Upvote 0
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

Code:
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
 
Upvote 0
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
Code:
    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.
Code:
    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.
 
Last edited:
Upvote 0
hi,
if you want to have variable r start at a particular value then just add the additional line of code shown in red


Rich (BB code):
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
 
Upvote 0

Forum statistics

Threads
1,213,543
Messages
6,114,238
Members
448,555
Latest member
RobertJones1986

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top