Match Column Headers And Merge Worksheets

Question

I have an excel workbook with several sheets containing data but their column headers are not in the same order. I also have a sheet called "Template" that contains column names and I need to merge all worksheet and bring them into Template.

Ex- 
Sheet 1 = Name DOB Age
          Sam   1/2 22
          Pat 22/6  25
Sheet 2 = DOB Age Name
           5/6 21 Peter
Sheet 3 = Name
           Ben
Sheet 4 = Age
           27/9

Template = Name Age DOB 
           Sam   22 1/2 
           Pat   25 22/6  
           Peter 21  5/6
           Ben    0   0
            0     0   27/9

so Template should concatenate one under the other all data from the worksheets, leave 0 wherever a column is not present in the corresponding sheet.

The below code does it correctly for 1 worksheet, but when I create a look to include all sheets, it over writes the data.

  Sub CopyHeaders()
    Dim header As Range, headers As Range
    Dim ws2 As Worksheet
    Dim Template As Worksheet
    Dim cell As Range
    For Each ws2 In ActiveWorkbook.Worksheets
    If IsError(Application.Match(ws2.Name, _
    Array("Template", "Sheet1"), 0)) Then
    Set Rng = ws2.UsedRange
    For Each cell In Rng
      If cell.Value = "" Then cell.Value = "0"

    Next
    Set headers = ws2.Range("A1:Z1")
    For Each header In headers
        If GetHeaderColumn(header.Value) > 0 Then
        Range(header.Offset(1, 0), header.End(xlDown)).Copy Destination:=Worksheets("Template").Cells(2, GetHeaderColumn(header.Value)).End(xlDown).End(xlUp).Offset(1, 0)
        End If
    Next
    End If
    Next
End Sub
Function GetHeaderColumn(header As String) As Integer
    Dim headers As Range
    Set headers = Worksheets("Template").Range("A1:Z1")
    GetHeaderColumn = IIf(IsNumeric(Application.Match(header, headers, 0)), Application.Match(header, headers, 0), 0)
End Function

My error is particularly at

Range(header.Offset(1, 0), header.End(xlDown)).Copy Destination:=Worksheets("Template").Cells(2, GetHeaderColumn(header.Value)).End(xlDown).End(xlUp).Offset(1, 0)

Need help please!

You need to find the last used row, not last cell in a column as there may be information lower in a different column. That data would then get overwritten — Tragamor

bobajob bobajob · Accepted Answer · 2016-11-29T11:42:36

You need to change the 2 in Cells(2, GetHeaderColumn(header.Value)) in the offending line to something large, potentially Worksheets("Template").Rows.Count(which means you can also remove the .End(xlDown)).

.End(xlDown).End(xlUp) which you have at the moment finds the bottom of a contiguous range if you are already at the bottom (as in the case of the first copy), but finds the top if you are anywhere else in the range (as row 2 will be for any further copy), thus you will start overwriting.

Match Column Headers And Merge Worksheets

1 Answers