Importing data from multiple workbooks to one sheet in master workbook

kakiebos

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

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
5,280
Office Version
2013
Platform
Windows

kakiebos

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

Board Regular
Joined
Jun 10, 2018
Messages
59
Hi,
have a look that this article by Ron de Bruin which may do what you want.:https://docs.microsoft.com/en-us/previous-versions/office/developer/office-2007/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

Well-known Member
Joined
Jul 3, 2012
Messages
5,280
Office Version
2013
Platform
Windows
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
 

kakiebos

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

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
5,280
Office Version
2013
Platform
Windows
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
 

Forum statistics

Threads
1,082,309
Messages
5,364,424
Members
400,801
Latest member
julievandermeulen

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top