Merge several sheets into one

[coolkiran]

I am merging several worksheets based on column name into one. There is common column across several sheets. I mean Firstname will be in sheet1, sheet4 ... etc.

There is no fixed sheets, In some cases it will be two sheets, sometime 10 sheets.

I would like final sheet into new workbook.

Simple excel file attached here.

Is that possible?

 

[Smallman]

@coolkiran

Your problem is an odd one as all of the columns are mixed which you don't see that very often. In order to solve the puzzle you have to trap the columns. I may have oversimplified the problem as there may be a whole heap more column headings to search for. In which case I would create a list of possible sheet names.

In any case you will need some kind of logic to drive the ouput sheet. So you need to suggest a logical order and this is what I have tried to do. The output matches yours and should work on larger datasets.

Option Explicit
 
Sub MoveCol()
Dim ar As Variant
Dim i As Integer
Dim j As Long
Dim n As Integer
Dim ws As Worksheet
Dim r As Range
Dim lr As Long
 
'Set the Array Values
ar = Array("First Name", "Last Name", "Name1", "Age", "Salary")
 
    For n = 1 To Worksheets.Count - 1
    lr = Sheet4.Range("A" & Rows.Count).End(xlUp).Row + 1
        For i = 0 To UBound(ar) 'Loop through the Array
            Set r = Sheets(n).[A1:AW1].Find(ar(i))
            If Not r Is Nothing Then
                Sheets(n).Range(Sheets(n).Cells(2, r.Column), Sheets(n).Cells(Rows.Count, r.Column).End(xlUp)).Copy _
                Sheet4.Range("A" & lr).Offset(, i)
            End If
        Next i
    Next n
End Sub

Give it a try. It assumes your output sheet is at the far right. That is an important point to remember cause I made the loop go from sheet one on the left to the second last sheet on the right. File attached.

I wrote an article on this problem some time back which you can find here.

Columns Which Meet Criteria

Take care

Smallman

 

[coolkiran]

Thanks smallman for your time.

I saw your code. But small issue again, because, column name is not fixed. so i can't use it in code.

I have some ideas, but i am not an expert to execute in vba.

Here it is, Copy row1 from all sheet and save it in new sheet, delete duplicate columns, once done, i guess i can use your code to fix remaining.

Is that works?

 

[Smallman]

@coolkiran

I realise your column Name is not fixed. If you think about what I have done - really think about it - you will see the logic and its simplicity. It is scalable for your problem. Can you upload a situation where it might fail as it should work on many levels.

I can create the changes to VB if you can articulate the problem correctly.

Take care

Smallman

 

[coolkiran]

Congratulation for 1000th post Smallman,

Code is perfect, only the line

ar = Array("First Name", "Last Name", "Name1", "Age", "Salary")

Can we make this column names from vba code because we never know this column names will be in other files and also there will be new columns may come. Sorry if i am not able to understand it?

 

[Smallman]

@coolkiran

When I said this in Post 2

I may have oversimplified the problem as there may be a whole heap more column headings to search for. In which case I would create a list of possible sheet names.

I was saying what you said in post 5. I was already thinking about it from a broader perspective.

Yes you should create a list in Excel. Lets say your list was in Column M of Sheet4 (your consolidation sheet).

CHand the code from your post 5 to

ar = range("M2", range("M" & rows.count).end(xlup))

That will put your list into the array

Now change everywhere it says ar(i) to ar(i,1)

Find and replace is your friend.

Let me know if you have any problems.

Take care

Smallman

 

[coolkiran]

I am sorry,
I was not clear on

Yes you should create a list in Excel. Lets say your list was in Column M of Sheet4 (your consolidation sheet).

How we can create it in runtime.

 

[Smallman]

Hi Coolkiran

In answer to your post via PM - In order for you to generate a list at run time you will need to create a list with unique values from all of the header rows in a spreadsheet. As you are doing this procedure with VBA the fastest way to generate a unique list would be to

Copy the headers and stack them via a Transpose, in on sheet. Now run an advanced filter over the Column which plucks out the Unique items.

You can then use this list for the basis for your search in conjunction with my coding.

That will get you over the line. Happy to help you compose the coding

Take care

Smallman

 

[coolkiran]

Thanks smallman

I will never say NO for this

Happy to help you compose the coding

After seeing your previous code.

Please. I loved your clear explanation. I will try myself as well.

 

[Smallman]

Sorry for the delay - dinner. Misses cooked Lamb.

Here is what I spoke of:

Sub MoveCol2()
Dim ar As Variant
Dim i As Integer
Dim j As Long
Dim n As Integer
Dim ws As Worksheet
Dim r As Range
Dim lr As Long

[M2:N500].ClearContents
'Set the Array Values
    For n = 1 To Worksheets.Count - 1
        Sheets(n).[A1:L1].Copy
        Range("M" & Rows.Count).End(xlUp)(2).PasteSpecial xlPasteAll, , , True
    Next n
    Range("M1", Range("M" & Rows.Count).End(xlUp)).AdvancedFilter xlFilterCopy, , [N1], True
    ar = Range("N2", Range("N" & Rows.Count).End(xlUp))
    'Original Code with a minor Exception
    For n = 1 To Worksheets.Count - 1
    lr = Sheet4.Range("A" & Rows.Count).End(xlUp).Row + 1
        For i = 1 To UBound(ar) 'Loop through the Array
            Set r = Sheets(n).[A1:AW1].Find(ar(i, 1))
            If Not r Is Nothing Then
                Sheets(n).Range(Sheets(n).Cells(2, r.Column), Sheets(n).Cells(Rows.Count, r.Column).End(xlUp)).Copy _
                Sheet4.Range("A" & lr).Offset(, i - 1)
            End If
        Next i
    Next n
End Sub

I thought it best if I included the whole procedure. It will create a unique list on the fly and generate your desired table.

I will attach a file to show workings.

Take care

Smallman