I have three large spreadsheets that need to have all of their information
consolidated into one workbook. The spreadsheets share Column Headings and
some similar information but some information will be unique only to its
spreadsheet. What I want to do is have all three spreadsheets merged into
one. Keep all of the column heading that aren't repeated from workbook to
workbook as well as the information contained within.

Put the three spreadsheets into one workbook and delete all other sheets from
the workbook. The code below will add a Summary Sheet to the workbook and
combine all the other sheets into the summary sheet. The code assumes that
column A on all the worksheets are row headers and copies the column A from
the original sheet to column A of the summary sheet. All other columns the
code check Row 1 for the column header and puts the columns with the same
headers together, otherwise, it create a new column and put the data in the
new column. The code doesn't cobine rows from the different worksheets


Sub combinesheets()

First = True
For Each sht In Sheets
If sht.Name < "Summary" Then
If First = True Then
sht.Copy after:=Sheets(Sheets.Count)
Set SummarySht = ActiveSheet
SummarySht.Name = "Summary"
First = False
LastCol = SummarySht.Cells(1, Columns.Count).End(xlToLeft).Column
NewCol = LastCol + 1
Else
With SummarySht
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
NewRow = LastRow + 1
'Copy header column from old sht to new sheet
'skip 1st row
LastRow = sht.Range("A" & Rows.Count).End(xlUp).Row
Set CopyRange = sht.Range("A2:A" & LastRow)
CopyRange.Copy Destination:=.Range("A" & NewRow)
ColCount = 2
Do While sht.Cells(1, ColCount) < ""
Header = sht.Cells(1, ColCount)
'Test if header is on new summary sheet
Set c = .Rows(1).Find(what:=Header, _
LookIn:=xlValues, lookat:=xlWhole)
Set CopyRange = sht.Range(sht.Cells(2, ColCount), _
sht.Cells(LastRow, ColCount))
If c Is Nothing Then
.Cells(1, NewCol) = Header
CopyRange.Copy Destination:=.Cells(NewRow, NewCol)
NewCol = NewCol + 1
Else
CopyRange.Copy Destination:=.Cells(NewRow, c.Column)
End If

ColCount = ColCount + 1
Loop
End With
End If

End If
Next

End Sub


"JLB's Excel Solutions" wrote:

I have three large spreadsheets that need to have all of their information
consolidated into one workbook. The spreadsheets share Column Headings and
some similar information but some information will be unique only to its
spreadsheet. What I want to do is have all three spreadsheets merged into
one. Keep all of the column heading that aren't repeated from workbook to
workbook as well as the information contained within.