Consolidating multiple sheet with different headers

[Gokul224455]

Hi All,

I am trying to consolidate sheets in same workbook using vba code. But I'm getting Overflow error. Please find the below code and help me out for the same.

Sub test()

Dim ws As Worksheet, a, b, dic As Object, txt As String

Dim i As Long, ii As Long, iii As Long, flg As Boolean

Const wsName As String = "Combined"

Set dic = CreateObject("Scripting.Dictionary")

dic.CompareMode = 1

If Not Evaluate("isref('" & wsName & "'!a1)") Then Sheets.Add.Name = wsName

Sheets(wsName).Cells.ClearContents

GetHeader dic, wsName

ReDim b(1 To 500000, 1 To dic.Count)

For ii = 0 To dic.Count - 1

b(1, ii + 1) = dic.keys()(ii)

Next

With CreateObject("Scripting.Dictionary")

.CompareMode = 1

For Each ws In Worksheets

If ws.Name <> wsName Then

a = ws.Cells(1).CurrentRegion.Value

For i = 2 To UBound(a, 1)

For ii = 0 To 11

For iii = 1 To 1

If dic.keys()(ii) = a(1, iii) Then

txt = txt & Chr(2) & a(i, iii): flg = True: Exit For

End If

If Not flg Then

MsgBox "Header A doesn't match", vbCritical

Exit Sub

End If

Next

Next

If flg Then

If Not .exists(txt) Then .Item(txt) = .Count + 2

For ii = 1 To UBound(a, 2)

b(.Item(txt), dic(a(1, ii))) = a(i, ii)

Next

End If

flg = False: txt = ""

Next

End If

Next

i = .Count + 2

End With

With Sheets(wsName).Cells(1).Resize(i, UBound(b, 2))

.Value = b

.Columns.AutoFit

End With

End Sub



Private Sub GetHeader(dic As Object, wsName As String)

Dim ws As Worksheet, a, ii As Long

For Each ws In Worksheets

If ws.Name <> wsName Then

a = ws.Cells(1).CurrentRegion.Rows(1).Value

For ii = 1 To UBound(a, 2)

If Not dic.exists(a(1, ii)) Then dic(a(1, ii)) = dic.Count + 1

Next

End If

Next

End Sub