VBA merge columns with the same header from multiple Workbooks to one Sheet

[MMriuSS]

Hi!

I've created a macro that combines data from many Workbooks that are found in Sheets ("IMPORT"). The data range is between cells with "Date" and "End". However, such merging is inaccurate if the number of columns in the merged data is different. The column header names are the same in all merged data.

The macro also adds the file names from which the data originates - SummarySheet.Range("A" & NRow).Value = FileName

I am asking for help in refining the macro so that it will merge data by head name, for example Date-Date, Time-Time, Mark-Mark, Color-Color, etc.

I have read many posts about similar topics on numerous internet forums and it seems to me that one of the solutions may be to use the Scripting Dictionary object.

Unfortunately, I do not know how to connect with each other.

I am asking for help or guidance.


My code:

<code style="margin: 0px; padding: 0px; font-style: inherit; font-weight: inherit; line-height: 12px;">Sub GAMMA() 

Application.ScreenUpdating = False 
Application.Calculation = xlCalculationManual 
Application.EnableEvents = False 
Application.StatusBar = "Importing and merging files" 


Dim SummarySheet As Worksheet 
Dim FolderPath As String 
Dim NRow As Long 
Dim FileName As String 
Dim WorkBk As Workbook 
Dim SourceRange As Range 
Dim DestRange As Range 
Dim i As Long 
Dim LastColumn As Long 
Dim FirstCell As Long 
Dim LastCell As Long 

      
    Set SummarySheet = Worksheets("Sheet1") 

FolderPath = "E:\TEST\" 

NRow = 1 

FileName = Dir(FolderPath & "*.xl*") 

Do While FileName <> "" 

    Set WorkBk = Workbooks.Open(FolderPath & FileName) 
    
    SummarySheet.Range("A" & NRow).Value = FileName 
    
    With WorkBk.Worksheets("IMPORT") 
        
        LastColumn = .UsedRange.Columns.Count 
        
        For i = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row 
    
            If .Cells(i, "A").Value = "Date" Then FirstCell = i '+ 1 
    
            If .Cells(i, "A").Value = "End" Then LastCell = i - 1: Exit For 
        
        Next i 

        Set SourceRange = .Range(.Cells(FirstCell, 1), .Cells(LastCell, LastColumn)) 
      
        With SourceRange 
             Set DestRange = SummarySheet.Range("B" & NRow).Resize(.Rows.Count, .Columns.Count) 
        End With 

        DestRange.Value = SourceRange.Value 

        NRow = NRow + DestRange.Rows.Count 
    
   End With 
        
   WorkBk.Close SaveChanges:=False 

   FileName = Dir() 

Loop 

MsgBox "Ready!" 

Application.ScreenUpdating = True 
Application.Calculation = xlCalculationAutomatic 
Application.EnableEvents = True 
Application.StatusBar = False 
End Sub</code>

 

[Fluff]

Cross posted https://www.excelforum.com/excel-pr...der-from-multiple-workbooks-to-one-sheet.html

While we do not prohibit Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules).
This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.

This is especially true as you have already indicated on the other site that everything's ok.