Transfer Data Multiple Workbooks Master Workbook Automatically

We can transfer data from multiple workbooks into a master Excel workbook automatically using VBA.
We have, let’s say, four Excel workbooks with the names: supplier-a.xlsx, supplier-b.xlsx, supplier-c.xlsx and zmaster.xlsm in the folder ‘C:Work\Excel_Tutorial’.
Screen shots of the data containing files is given below:

Data of Supplier-a

Data of Supplier-a

Data of Supplier-b

Data of Supplier-b

supplier-c-data

supplier-c-data

zmaster-data

zmaster-data


The complete macro code is given below:

Sub LoopThroughDirectory()
Dim MyFile As String
Dim erow
Dim Filepath As String
Filepath = “C:\Work\Excel_Tutorial\”
MyFile = Dir(Filepath)
Do While Len(MyFile) > 0
If MyFile = “zmaster.xlsm” Then
Exit Sub
End If

Workbooks.Open (Filepath & MyFile)
Range(“A2:D2”).Copy
ActiveWorkbook.Close

erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets(“Sheet1”).Range(Cells(erow, 1), Cells(erow, 4))

MyFile = Dir
Loop
End Sub

Note: Many thanks to Darren Elliot, a proactive website visitor,  who contributed to a major correction in the above code.

Watch the Excel training video to see how the complete process of moving multiple files from one folder to another is implemented:


Further reading:
Range.Cells Property (Excel)

39 thoughts on “Transfer Data Multiple Workbooks Master Workbook Automatically

  1. Felicia Wong

    Hi, I have tried your VBA but I got an error “Runtime error 424” Object Required :
    erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

    Please advise, thanks,

    Reply
    1. chander shekhar

      what is the vb code if suppliers files have multiple sheets and we have to transfer data from sheet no 5 of each suppliers file into master file

      Reply
        1. Fahim

          Dear Sir,

          I have created a Master file as below link. I am also sending the data source files. What I am facing is if any of the source file filtered during work, the macro can import only the visible rows data to master file.

          https://www.dropbox.com/sh/s3dnjvs44eood36/AAAkm8COeNq5v6_0NnP3Lru4a?dl=0

          1) I need all rows data from the source files to be exported to master file once I will press the “Update Data” command button in master file.

          2) Also I have added two buttons, “Clear Data” button for clearing the old data from Master file and “Update Data” button for update new data in Master file. Here is it possible to do two above jobs (Clearing old data and update with new data) with only one Command button “Update Data”.

          I am eagerly waiting if you help me.

          Reply
        2. amit

          hi, how to copy data in horizontally(column) based on file name(date) to master xls date column.

          All slave file having information on E5 to E9, file name eg. “Report_S3_UP W_352315062479619_15Jun19_220002.1_template_22042015” one file for a day. i want to copy this 5 row information of per file to per date column in the master sheet

          Reply
  2. umakant

    Dear sir,

    i need your help for set dir default path. if i move file to different location .it should be automatically set directory path .

    MYFile =dir(c:\supplier\test)

    Reply
  3. Val Cardoza

    Dear Sir

    I have a master file with new pay package like basic salary, allowances etc to all employees as one worksheet in the file. I have 450+ individual employee time sheet files.

    I wish to transfer basic data like wages in to all files from the master files. the timesheets are all in the similar format.

    can you help me with a vba code so that i can save lot of time and this is usual work for me every year. here Employee code remains unique in master workbook and also time sheets workbook files. Sir can you please help me to solve this problem

    Many thanks in advance
    Val Cardoza

    Reply
    1. http://www./

      Thank you so much! I've spent the last few hours trying to find this data for download, which isn't mentioned on the CPRM page. Apologies for commenting in English, it's the only language I know.

      Reply
    2. blue discounts wny

      Kjempe flott pute du har laget deg moa, og det broderiet var kjempe flott…..Var selv pÃ¥ loppis i dag og fant masse flott, blant annet en kjempe fin blomstrete lampeskjerm, som med en gang jeg sÃ¥ den sÃ¥ tenkte jeg pÃ¥ deg…..ha en fin søndag vidre snuppaklemmer i fleng

      Reply
  4. dharmateja

    I am trying to use this code but it is not showing any result. Could you please help me in this thing.
    It is not showing any errors also.

    Reply
  5. dharmateja

    I am trying to use this code but it is not showing any result. Could you please help me in this thing.
    It is not showing any errors also.
    This is the code which i tried

    Sub copy()

    Dim myfile As String
    Dim erow
    Dim Filepath As String

    Filepath = “G:\VBA\”

    myfile = Dir(Filepath)

    Do While Len(myfile) > 0
    If myfile = “Master.xlsm” Then
    Exit Sub
    End If

    Workbooks.Open (Filepath & myfile)
    Range(“A2:C2”).copy
    ActiveWorkbook.Close

    erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

    ActiveSheet.Paste Destination:=Worksheets(“sheet1”).Range(Cells(erow, 1), Cells(erow, 3))

    myfile = Dir

    Loop

    End Sub

    Reply
  6. F

    Hey there,

    Like the person above, I’m not getting any results (or any errors). The only thing I modified is the directory location and the cell range I want to paste (A3:M3). Here’s the code:

    Sub LoopThroughDirectory()
    Dim MyFile As String
    Dim erow
    Dim Filepath As String
    Filepath = “C:\Users\iaslab\Desktop\HBD_Rescored_141114 – Copy”
    MyFile = Dir(Filepath)
    Do While Len(MyFile) > 0
    If MyFile = “zHBD_Compiled.xlsm” Then
    Exit Sub
    End If

    Workbooks.Open (Filepath & MyFile)
    Range(“A3:M3”).Copy
    ActiveWorkbook.Close

    erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    ActiveSheet.Paste Destination:=Worksheets(“Sheet1”).Range(Cells(erow, 1), Cells(erow, 4))

    MyFile = Dir
    Loop
    End Sub

    Reply
  7. Subham Mishra

    Hi DInesh,

    How can I add data from different workbooks into a master workbook having same headers and row labels?

    e.g. I have Distributor plan workbook containing 6 different sheets, which is sent to be filled by around 150 Distributors. I am getting replies from them. Now i want the sum of all the replies in a master sheet, which is designed same as the file sent to the distributors.
    So how can I get that done?

    Please help.

    Thanks in advance…!!

    Reply
  8. Anaand

    Sir,

    in the above example, the entire row containing ‘Car’ is copied to another sheet. a slight addition in requirement, I would like to refer to the cell containing ‘Car’ in sheet 1 and copy the entire contents in that row to sheet 2 after the cell that contains ‘Car’. i.e. data of matching cells to be copied to another sheet against that cell.

    regds,

    Anaand Kulkarni

    Reply
  9. bpatmurray

    Hello sir,

    I have a question adapting your code my my situation. I am trying to compile the data from multiple files into one, as you did. The sheet is “Admissions” and it is a large mulitple row/column dataset I am copying. Everytime I run the code it gives me a runtime error 1004 applicaiton-defined or object defined error and leads me to my activesheet.paste command for debugging. I can not see what the error is an hope you can point it out to me.

    Many Thanks.

    Brian

    Sub AdmissionTransfer()
    Dim MyFile As String
    Dim erow
    Dim endrow
    Dim FilePath As String
    Dim AdmDate As String
    Dim Admits As Range

    FilePath = “C:\Users\brian.murray\Downloads\”
    MyFile = Dir(FilePath)

    Do While Len(MyFile) > 0

    If MyFile = “ztest.xlsm” Then
    Exit Sub
    End If

    Workbooks.Open (FilePath & MyFile)
    Sheets(“Admissions”).Select
    AdmDate = Cells(1, 1).Value
    endrow = Cells(Rows.Count, 4).End(xlUp).Offset(0, 0).Row
    Range(Cells(3, 4), Cells(endrow, 13)).Copy

    ActiveWorkbook.Close

    ActiveSheet.Paste Destination:=Worksheets(“Admissions”).Range(Cells(erow, 2), Cells(erow + endrow – 3, 11))
    Worksheets(“Admissions”).Range(“A” & erow).Value = AdmDate
    Worksheets(“Admissions”).Range(“A” & erow, “A” & erow + endrow – 3).FillDown

    MyFile = Dir

    Loop

    End Sub

    Reply
  10. harbi

    I copied the same code but it is giving me error- Run Time Error “424”
    If MyFile = “zmaster.xlsx” then

    Donr know what is wrong?

    Sub LoopThroughDirectory()
    Dim MyFile As String
    Dim erow
    Dim Filepath As String
    Filepath = “D:\Users\hm10345\Desktop\supplier-master\”

    MyFile = Dir(Filepath)
    Do While Len(MyFile) > 0
    If MyFile = “zmaster.xlsx” Then
    Exit Sub
    End If

    Workbooks.Open (Filepath & MyFile)
    Range(“A2:D2”).Copy
    ActiveWorkbook.Close

    erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    ActiveSheet.Paste Destination:=Worksheets(“Sheet1”).Range(Cells(erow, 1), Cells(erow, 4))

    MyFile = Dir
    Loop
    End Sub

    Reply
  11. winston

    Sir,

    I’m getting an error for the below code:

    Sub LoopThroughDirectory()
    Dim MyFile As String
    Dim erow
    Dim Filepath As String

    Filepath = “C:\Users\Winston\Documents\Family Budget\Fiscal Year 11-12\”

    MyFile = Dir(Filepath)

    Do While Len(MyFile) > 0
    If MyFile = “YearlyExpense.Xlsm” Then
    Exit Sub
    End If

    Workbooks.Open (Filepath & MyFile)
    Worksheets(“Categorized”).Range(“B32:V32”).Copy
    ActiveWorkbook.Close

    erow = Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    ActiveSheet.Paste Destination:=Worksheets(“sheet2”).Range(Cells(erow, 1), Cells(erow, 22))

    MyFile = Dir
    Loop
    End Sub

    The error is Runtime error 1004 “FileName” could not be found error

    It is displaying the file it found “FileName”. Kindly, check my complete requirement under the following link:

    http://stackoverflow.com/questions/29860343/

    Kindly, help!

    Reply
  12. Inam Ullah

    Sir,
    I created three supplier files as like you and one master file and save them in Supplier-master folder. and then create the code same as your’s but when i try to run this code its give me the error “424”.
    I tried to much to solve this problem but i can not do this and I need your valuable support.

    Reply
  13. Sandhya

    I copies the above code :
    but i need to copy range of data i.e. ranged cells need to copy at one location and followed by emply line next file data has to copy.

    Kindly help me in this regard.

    Sub LoopThroughDirectory()
    Dim MyFile As String
    Dim erow
    Dim Filepath As String
    Filepath = “C:\Work\Excel_Tutorial\”
    MyFile = Dir(Filepath)
    Do While Len(MyFile) > 0
    If MyFile = “zmaster.xlsm” Then
    Exit Sub
    End If

    Workbooks.Open (Filepath & MyFile)
    Range(“A2:D2”).Copy
    ActiveWorkbook.Close

    erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    ActiveSheet.Paste Destination:=Worksheets(“Sheet1”).Range(Cells(erow, 1), Cells(erow, 4))

    MyFile = Dir
    Loop
    End Sub

    Reply
  14. bhupender

    I have created 3 supilers which has different-2 range like (Suplier -1 (A2:D50) next suplier range is (A2:D10) and (A2:D60), so kindly suggest me how I can manipulate my range so that i can get all information. Please help me as soon as possible

    Sub LoopThroughDirectory2()
    Dim MyFile As String
    Dim erow
    Dim Filepath As String
    Filepath = “D:\Camera\”
    MyFile = Dir(Filepath)
    Do While Len(MyFile) > 0
    If MyFile = “mastershert.xlsm” Then
    Exit Sub
    End If

    Workbooks.Open (Filepath & MyFile)
    Range(“A2:D10”).Copy
    ActiveWorkbook.Close

    erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    ActiveSheet.Paste Destination:=Worksheets(“Sheet1”).Range(Cells(erow, 1), Cells(erow, 4))

    MyFile = Dir
    Loop
    End Sub

    Reply
  15. bhupender

    Hello,

    I Tried this but still I am facing problem, so please help me as soon as possible.

    Sub LoopThroughDirectory2()
    Dim MyFile As String
    Dim erow
    Dim lastrow As Long
    Dim Filepath As String
    Filepath = “D:\Camera\”
    MyFile = Dir(Filepath)
    Do While Len(MyFile) > 0
    If MyFile = “mastershert.xlsm” Then
    Exit Sub
    End If

    Workbooks.Open (Filepath & MyFile)
    lastrow = Sheets(“sheet1”).Range(“A” & Rows.Count).End(xlUp).Row
    Range(“A” & lastrow).Copy

    ActiveWorkbook.Close

    erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    ActiveSheet.Paste Destination:=Worksheets(“Sheet1”).Range(Cells(erow, 1), Cells(erow, 4))

    MyFile = Dir
    Loop
    End Sub

    Reply
  16. nagendra

    sir, I am struck up in peculiar problem, we have an excel sheet which has work order and counter and process name and process stage, everyday we have 100’s of workorder and i am manually looking at the same and updating, i want this to be automated,, can you please give me your email id to share data

    Reply
  17. Neeraj Jha

    Dear Sir,

    I hope you are doing well.

    I have a query with, I have multiple worksheets more than 15 and i want to copy data from each worksheet, “sheet1” and paste that data in Consolidate data file in “Sheet1” that format in excel 2003.

    Can it is possible, i was use all suggested code which you are recommend in your website.

    Regards,
    Neeraj Jha

    Reply
  18. Wagner

    Hi there,
    Thank you for your help… I have tried to adapt the code to my needs, but unfortunately it is not working

    I want to copy the cells from D8:P8 that are located in the SUMMARY worksheet in each workbook, and paste in to my “LME Master Log Summary” (in the Master Summary worksheet)

    Please help

    ———————————-
    Sub LMEMaster()
    Dim MyFile As String
    Dim erow
    Dim Filepath As String
    Filepath = ThisWorkbook.Path
    MyFile = Dir(Filepath)
    Do While Len(MyFile) > 0
    If MyFile = “LME Master Log Summary.xlsm” Then
    Exit Sub
    End If

    Workbooks.Open (Filepath & MyFile)
    Worksheets(“SUMMARY”).Activate
    Range(“D8:P8”).Copy
    ActiveWorkbook.Close

    erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    ActiveSheet.Paste Destination:=Worksheets(“Master Summary”).Range(Cells(erow, 1), Cells(erow, 4))

    MyFile = Dir
    Loop
    End Sub

    ————————————————

    Reply
  19. Nate

    The current code is excellent but can you please show how and where do I add in additional row selection criteria to this existing code? My each of my sheets have multiple years so I want to make a master sheet by Year which for me Year is the column header in column 4 of each of the sheets. For instance if I only want to make a master sheet for “2015” where would I add this in and what additional dim or IF criteria do I need to add?
    Thanks

    Thanks

    Reply
  20. Naveen

    Hi…
    1. I wanted to copy whole data from 2 or 3 excel files which will contain a single sheet inside and paste them (over writing the previous contents except the column header) in master excel. and delete those source files.
    2. and this should repeat once in every day at a given time, automatically using macro.
    can any one help me on this please..

    Reply

Leave a Reply

Your email address will not be published. Required fields are marked *