How to Merge several Workbooks using specific Headers

Question

I have hundreds of Excel files I need to merge, but I only need some specific columns with the same header from each file. Because the excel headers are all over the place I cannot merge them by column numbers (or letter), but by the headers. In this way I can have one workbook with all the data found under the same header.

I currently have succesfully merge all the workbooks in one single master file, but with the columns all messy, so the code really doesnt help my problem. The main idea is to: Copy & paste and loop the specific columns from each file found in the path to a new WB.

'Merge all WB in a folder
Sub FileMerger()
    Dim bookList As Workbook
    Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
    Application.ScreenUpdating = False
    Set mergeObj = CreateObject("Scripting.FileSystemObject")


    Set dirObj = mergeObj.Getfolder("Here is the path were all my excel files are found.xml")  'PATH
    Set filesObj = dirObj.Files

    For Each everyObj In filesObj
        Set bookList = Workbooks.Open(everyObj)

        Range("A2:IV" & Range("A65536").End(xlUp).Row).Copy                                         'A65536 is the last row for Colmn A
        ThisWorkbook.Worksheets(1).Activate

        Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
        Application.CutCopyMode = False
        bookList.Close
    Next
End Sub

As you can see from my code, it is only the merging part of the code, since I dont know how to add the part to merge only specific headers.

I will greatly appreciate if you could help me complete this code. For the headers you can use "Header1", "Header2", "Header3", "Header4", and "Header5" as examples. I have been trying to complete this code for several days and it is the only missing part to finish my project.

Answer 1

Here, I commented the code but you can ask if something doesn't add or need further explanation:

    Option Explicit
    Sub FileMerger()

        Dim bookList As Workbook, ws As Worksheet
        Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
        Dim bookListlrow As Long, wblrow As Long, i As Long, MasterHeader As Integer
        Dim arrHeaders, HeaderFind

        Application.ScreenUpdating = False

        Set ws = ThisWorkbook.Sheets("MasterWorksheet") 'change "MasterWorksheet" for the name of your sheet (in the master wb)
        arrHeaders = Array("Header1", "Header2", "Header3", "Header4") 'here you define all the headers you want to look for

        Set mergeObj = CreateObject("Scripting.FileSystemObject")
        Set dirObj = mergeObj.Getfolder("Here is the path were all my excel files are found.xml")  'PATH
        Set filesObj = dirObj.Files

        For Each everyObj In filesObj
            'is better to avoid the update and to open it as readonly to avoid potential errors in case someone else opens it
            Set bookList = Workbooks.Open(everyObj, UpdateLinks:=False, ReadOnly:=True)
            With bookList.Sheets(1) 'assuming your first sheet on the workbook is the one to copy
                For i = LBound(arrHeaders) To UBound(arrHeaders) 'a loop through all your headers
                    'header on your master worksheet. I declared it as integer because I expect all the headers to be on this sheet.
                    MasterHeader = Application.Match(arrHeaders(i), ws.Rows(1), 0)
                    'set the last row for your main workbook
                    wblrow = ws.Cells(ws.Rows.Count, MasterHeader).End(xlUp).Row + 1
                    HeaderFind = Application.Match(arrHeaders(i), .Rows(1), 0) 'this is assuming all your headers are on row 1
                    If Not IsError(HeaderFind) Then 'if we get a match on the header we copy the column
                        bookListlrow = .Cells(.Rows.Count, HeaderFind).End(xlUp).Row 'last row on that sheet
                        'copy paste on the same move since you are not pating values but everything.
                        .Range(.Cells(2, HeaderFind), .Cells(bookListlrow, HeaderFind)).Copy ws.Cells(wblrow, MasterHeader)
                    End If
                Next i
                Application.CutCopyMode = False
            End With
            bookList.Close SaveChanges:=False
        Next everyObj

        Applicaiton.ScreenUpdating = True

    End Sub

Answer 2

I just want check first if after you merged all your workbook into one, all data now can be found in one worksheet? Is your worksheet looks like the screenshot below?