Merge Data from Multiple Files

I need assistance in my current VBA (please see attached document).
I have 5 excel files saved in a folder on C drive. the macro is pulling all the data from all files saved in a .xlsx format and pasting it to the last empty row on the master workbook. I would want to switch this up and have each file from the folder to go to a specific tab in the master workbook. All the files in the folder have the same name and i would want them to go to the same specific tab. The files in the folder and the tabs have headers so i would want to extract the data from row A2. Another key request will be to have the data overwrite. i don't want it to look for the last row; always start from A2.

Ex. the 5 files in the folder are cars.xlsx, color.xlsx, model.xlsx, year.xlsx and type.xlsx

cars.xlsx should go to sheet1
color.xlsx should go to sheet2
model.xlsx should go to sheet3
year.xlsx should go to sheet4
type.xlsx should go to sheet5

Sub MergeTest2()

   Dim SummarySheet As Worksheet
    Dim NRow As Long
    Dim WorkBk As Workbook
    Dim SourceRange As Range
    Dim DestRange As Range
    Dim LastRow As Long
    'Disable Events
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
        .DisplayStatusBar = True
        .StatusBar = "!!! Please Be Patient...Updating Records !!!"
        .EnableEvents = False
        .Calculation = xlManual
    End With

    ' this line of code forces to put all collected data into this workbook Sheet Summary
     Set SummarySheet = ThisWorkbook.Worksheets("Summary")

    NRow = 1

MyFolder = "C:\New folder\"    ' rename the C:\New folder\ with your actual folder
MyFile = Dir(MyFolder & "\*.xlsx") '  if your file types are other than normal excel then rename xlsx
Do While MyFile <> ""    ' it says continue until the last file in the folder
FileName = MyFolder & "\" & MyFile

   Set WorkBk = Workbooks.Open(FileName)

        ' Get row number of last used row
        LastRow = WorkBk.Worksheets(1).Cells.Find(What:="*", _
                                                  After:=WorkBk.Worksheets(1).Cells.Range("A1"), _
                                                  SearchDirection:=xlPrevious, _
                                                  LookIn:=xlFormulas, _

        'if you want to see what data belongs to which workbook Set the cell in column Z to be the file name.
        'SummarySheet.Range("Z" & NRow).Value = FileName
        ' Create header row
        Set SourceRange = WorkBk.Worksheets(1).Range("A2:M2")  ' Change this range which is your workbooks
        Set DestRange = SummarySheet.Range("B2:M2") ' change this if it is going further to columns beyond M
        DestRange.Value = SourceRange.Value

        ' Modify this range for your workbooks. It can span multiple rows.
        Set SourceRange = WorkBk.Worksheets(1).Range("A2:M" & LastRow)

        ' Set the destination range to start at column A and be the same size as the source range.
        Set DestRange = SummarySheet.Range("B" & NRow)
        Set DestRange = DestRange.Resize(SourceRange.Rows.Count, SourceRange.Columns.Count)

        ' Copy over the values from the source to the destination.
        DestRange.Value = SourceRange.Value

        ' Increase NRow so that we know where to copy data next.
        NRow = NRow + DestRange.Rows.Count

        ' Close the source workbook without saving changes.
        WorkBk.Close savechanges:=False
     MyFile = Dir

    ' Call AutoFit on the destination sheet so that all data is readable.
    'Enable Events
    With Application
         .DisplayAlerts = False
        .ScreenUpdating = True
        .DisplayStatusBar = True
        .StatusBar = False
        .EnableEvents = True
        .Calculation = xlAutomatic
    End With
End Sub
Gary LensProject ManagerAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Mike in ITIT System AdministratorCommented:
You didn't attach anything.

If you want the data to always start at A2, do you want to delete the data that is currently there before importing the new data?
Gary LensProject ManagerAuthor Commented:
sorry about that...please see the attached file
LearnReporting Automation ExpertCommented:
Hi Gary Lens,

is that possible to share some same source file,

Determine the Perfect Price for Your IT Services

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden with our free interactive tool and use it to determine the right price for your IT services. Download your free eBook now!

Gary LensProject ManagerAuthor Commented:
The macro right now what it does, it creates the header and copy all the data from the files in the folder on my local drive. I would need assistance to just copy data from a file to a particular tab. All files have different columns..each file will have each own unique tab by name.. but the files are always going to be 5..
LearnReporting Automation ExpertCommented:
Hi Gary Lens,

Please find attached macro file for your reference and codding below

Hope this will help you.
Sub Merge()

    Dim Source As String
    Dim StrFile As String
    Dim WBname As String

    Application.ScreenUpdating = False
     Source = InputBox("Please enter file path")
    Source = Source & "\"
    StrFile = Dir(Source & "*.xlsx")
    Do While Len(StrFile) > 0
        Workbooks.Open Filename:=Source & StrFile
         WBname = ActiveWorkbook.Name
         Range(Selection, Selection.End(xlDown)).Select
         Range(Selection, Selection.End(xlToRight)).Select
         Worksheets.Add After:=Worksheets(Worksheets.Count)
         ActiveSheet.Name = Replace(WBname, ".xlsx", "")
         Application.CutCopyMode = False
         Workbooks(WBname).Close Savechanges = False
         StrFile = Dir()
    MsgBox "Macro completed", vbExclamation
End Sub

Open in new window


Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
LearnReporting Automation ExpertCommented:
I hope that this solution will help the requestor
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Office

From novice to tech pro — start learning today.