Matching header to copy data and add new header if header is not matched

[vidyavallaba]

Hi All,
I am trying to match headers of different files and copy data.If the one of the header is not matched then a new column with the non matching header should be created and the column has to be copied

Ex: file1.xlsx has AA BB CC as header
file2.xlsx has AA BB DD EE as header
file3.xlsx should contain AA BB CC DD EE i.e data from file1.xlsx and file2.xlsx


I have more than 300 files how can I copy all the files to one excel file by matching headers ?

 

[Rijnsent]

Hi vidyavallaba,

it sounds like you need a master file that tries to pull in all the data and need VBA code to do so. This "skeleton" should get you going:

Sub DoThisForAll()

Set ActWb = ActiveWorkbook
Set ActSht = ActWb.ActiveSheet

MyPath = Dir("c:\testfolder\")

sFil = Dir(MyPath & "*.xlsx") 'change or add formats
ResRw = 2

Do While sFil <> ""
    Set SrcWb = Workbooks.Open(sPath & "\" & sFil) 'opens the file
    Set SrcSht = SrcWb.ActiveSheet
    
    MaxColAct = ActSht.Cells(1, Cells.Columns.count).End(xlToLeft).Column
    MaxColSrc = SrcSht.Cells(1, Cells.Columns.count).End(xlToLeft).Column
    
    'Loop through all the columns
    ColFnd = False
    For Col = 1 To MaxColSrc
        For Col2 = 1 To MaxColAct
            If ActSht.Cells(1, Col).Value = ActSht.Cells(1, Col2).Value Then
                'Copy the data
                
                ColFnd = True
            Else
            End If
        Next Col2
        If ColFnd = False Then
            'Column not found, add to the right of the data
        Else
        End If
    Next Col
   
    SrcWb.Close True
    sFil = Dir
Loop


End Sub

Cheers,

Koen