not so easy VBA needed to combine data across multiple sheets

[Kellens]

Hello,

The idea is simple the execution not so i guess

I have a large number of sheets with 2 rows:

• the first has the headers in it
• the second has a number of values

the first column contains a unique article number

What i would like to do is have a script that adds all these rows below each other but fills in the values under the corresponding header...
You can find the excell with the tabs i would like to combine here:

http://www.sonic-websites.be/blog/wp-content/uploads/2015/02/test-bosch21.xlsx

In the tab result you can see what i'm trying to accomplish (mockup).
I really hope someone could help me with this!!!

Thanks in advance...

 

[Kellens]

I have this VBA code that works perfectly for something similar but there is one problem.
It starts with the data in sheet 1 and then combines similar data found in the other sheets.

Now the VBA code should combine and add rows (article numbers) as well as combine /add columns (new headers)

Maybe the code below could be adjusted?

Sub Consolidate()
Application.ScreenUpdating = False
'****************************************************
' Assumes all sheets are only data sheets that need to be consolidated
'****************************************************


'create sheet from existing FIRST tab
    Sheets(1).Copy Before:=Sheets(1)
    ActiveSheet.Name = "Consolidation"
    
 'next column for header
 nc = Cells(1, Columns.Count).End(xlToLeft).Column + 1
 'last reference
 LR = Cells(Rows.Count, 1).End(xlUp).Row
 'loop sheets
 For n = 3 To Sheets.Count
    Set ws = Sheets(n)
    Set Head = ws.Range("B1")
       For os = 0 To ws.Cells(1, Columns.Count).End(xlToLeft).Column - 2
            On Error Resume Next
            Header = 0
            Header = WorksheetFunction.Match(Head.Offset(0, os), Rows(1), 0)
            On Error GoTo 0
            
            If Header = 0 Then
                Cells(1, nc) = Head.Offset(0, os)
                Header = nc
                nc = nc + 1
            End If
            
           'check data
           For r = 1 To LR - 1
                If Not Head.Offset(r, os) = "" Then ActiveSheet.Cells(r + 1, Header) = Head.Offset(r, os)
                Next r
       Next os
    
 Next n
MsgBox "Done"
End Sub

 

[Kellens]

If some extra info is required or if i can help in any way i'll be monitoring the post allmost constantly

 

[Kellens]

no one able to help?
And if i ask nicely??
please

 

[Kellens]

Am i asking something so hard to do??