Option Explicit
Public Sub CombineSheetsWithDifferentHeaders()
Dim wksDst As Worksheet, wksSrc As Worksheet
Dim lngIdx As Long, lngLastSrcColNum As Long, _
lngFinalHeadersCounter As Long, lngFinalHeadersSize As Long, _
lngLastSrcRowNum As Long, lngLastDstRowNum As Long
Dim strColHeader As String
Dim varColHeader As Variant
Dim rngDst As Range, rngSrc As Range
Dim dicFinalHeaders As Scripting.Dictionary
Set dicFinalHeaders = New Scripting.Dictionary
dicFinalHeaders.CompareMode = vbTextCompare
lngFinalHeadersCounter = 1
lngFinalHeadersSize = dicFinalHeaders.Count
' delete rows 1-5 in each worksheet
Set wksDst = ThisWorkbook.Worksheets.Add
For Each wksSrc In ThisWorkbook.Worksheets
If wksSrc.Name <> wksDst.Name Then
With wksSrc
lngLastSrcColNum = LastOccupiedColNum(wksSrc)
For lngIdx = 1 To lngLastSrcColNum
strColHeader = Trim(CStr(.Cells(1, lngIdx)))
If Not dicFinalHeaders.Exists(strColHeader) Then
dicFinalHeaders.Add Key:=strColHeader, _
Item:=lngFinalHeadersCounter
lngFinalHeadersCounter = lngFinalHeadersCounter + 1
End If
Next lngIdx
End With
End If
Next wksSrc
For Each varColHeader In dicFinalHeaders.Keys
wksDst.Cells(1, dicFinalHeaders(varColHeader)) = CStr(varColHeader)
Next varColHeader
' only copy rows upto the month where column F or G has a value and ignore the rest
For Each wksSrc In ThisWorkbook.Worksheets
If wksSrc.Name <> wksDst.Name Then
With wksSrc
lngLastSrcRowNum = LastOccupiedRowNum(wksSrc)
lngLastSrcColNum = LastOccupiedColNum(wksSrc)
lngLastDstRowNum = LastOccupiedRowNum(wksDst)
For lngIdx = 1 To lngLastSrcColNum
strColHeader = Trim(CStr(.Cells(1, lngIdx)))
Set rngDst = wksDst.Cells(lngLastDstRowNum + 1, _
dicFinalHeaders(strColHeader))
Set rngSrc = .Range(.Cells(2, lngIdx), _
.Cells(lngLastSrcRowNum, lngIdx))
rngSrc.Copy Destination:=rngDst
Next lngIdx
End With
End If
Next wksSrc
MsgBox "Data combined!"
End Sub
Public Function LastOccupiedRowNum(Sheet As Worksheet) As Long
Dim lng As Long
If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
With Sheet
lng = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
End With
Else
lng = 1
End If
LastOccupiedRowNum = lng
End Function
Public Function LastOccupiedColNum(Sheet As Worksheet) As Long
Dim lng As Long
If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
With Sheet
lng = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
End With
Else
lng = 1
End If
LastOccupiedColNum = lng
' copy formatting of existing sheets to summary sheet
End Function