I have to combine some worksheets that have slightly different information in
them, to a single worksheet. Most of the columns are the same with the
exception of an odd column, and there a numerous additional rows that would
need to be added.

No one worksheet has at this stage got priority over another.

Any assistance in how to do this would be greatfully received.

Steve

Steve,

Put all the worksheets into the same workbook, if they aren't already, and then run the macro below.

It will combine the databases from all the sheets in a workbook, based on the field names in row 1
and the key values in column A. Note that you would need to have the same value in cell A1 of all
sheets, each table must start in cell A1, and be contiguous (no completely blank rows or columns).
For those fields that differ, the fields are left blank for the models that lack the information.

HTH,
Bernie
MS Excel MVP


Sub ConsolidateDatabasesMultiSheets()
Dim BaseBook As Workbook
Dim BaseSheet As Worksheet
Dim myBook As Workbook
Dim mySht As Worksheet
Dim myCell As Range
Dim myCell2 As Range
Dim myColumn As Integer
Dim myRow As Long
Dim FirstCopy As Boolean

FirstCopy = True

With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With

Set BaseSheet = Worksheets.Add
ActiveSheet.Name = "Combined"
For Each mySht In ActiveWorkbook.Worksheets
If mySht.Name < BaseSheet.Name Then
If FirstCopy Then
mySht.Cells.Copy BaseSheet.Range("A1")
FirstCopy = False
GoTo NextSheet:
End If
mySht.Activate
myRow = BaseSheet.UsedRange.Rows.Count + 1
For Each myCell In Intersect(Range("1:1"), _
ActiveSheet.UsedRange)
If myCell.Value < "" Then
If IsError(Application.Match(myCell.Value, _
BaseSheet.Range("1:1"), False)) Then
With BaseSheet.Range("IV1").End(xlToLeft)(1, 2)
..Value = myCell.Value
myColumn = .Column
End With
Else
myColumn = Application.Match(myCell.Value, _
BaseSheet.Range("1:1"), False)
End If

For Each myCell2 In Intersect(Range("A2:A65536"), _
ActiveSheet.UsedRange)
If IsError(Application.Match(myCell2.Value, _
BaseSheet.Range("A:A"), False)) Then
With BaseSheet.Range("A65536").End(xlUp)(2)
..Value = myCell2.Value
myRow = .Row
End With
Else
myRow = Application.Match(myCell2.Value, _
BaseSheet.Range("A:A"), False)
End If

BaseSheet.Cells(myRow, myColumn).Value = _
Cells(myCell2.Row, myCell.Column).Value
Next myCell2
End If
Next myCell
End If
NextSheet:
Next mySht

ActiveWorkbook.SaveAs Application.GetSaveAsFilename("Consolidated.xls")

With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With

End Sub


"Steve Lewington" <Steve wrote in message
...
I have to combine some worksheets that have slightly different information in
them, to a single worksheet. Most of the columns are the same with the
exception of an odd column, and there a numerous additional rows that would
need to be added.

No one worksheet has at this stage got priority over another.

Any assistance in how to do this would be greatfully received.

Steve

Thanks Bernie

I'm very grateful. Will try it out later today.

Regards

Steve

"Bernie Deitrick" wrote:

Steve,

Put all the worksheets into the same workbook, if they aren't already, and then run the macro below.

It will combine the databases from all the sheets in a workbook, based on the field names in row 1
and the key values in column A. Note that you would need to have the same value in cell A1 of all
sheets, each table must start in cell A1, and be contiguous (no completely blank rows or columns).
For those fields that differ, the fields are left blank for the models that lack the information.

HTH,
Bernie
MS Excel MVP


Sub ConsolidateDatabasesMultiSheets()
Dim BaseBook As Workbook
Dim BaseSheet As Worksheet
Dim myBook As Workbook
Dim mySht As Worksheet
Dim myCell As Range
Dim myCell2 As Range
Dim myColumn As Integer
Dim myRow As Long
Dim FirstCopy As Boolean

FirstCopy = True

With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With

Set BaseSheet = Worksheets.Add
ActiveSheet.Name = "Combined"
For Each mySht In ActiveWorkbook.Worksheets
If mySht.Name < BaseSheet.Name Then
If FirstCopy Then
mySht.Cells.Copy BaseSheet.Range("A1")
FirstCopy = False
GoTo NextSheet:
End If
mySht.Activate
myRow = BaseSheet.UsedRange.Rows.Count + 1
For Each myCell In Intersect(Range("1:1"), _
ActiveSheet.UsedRange)
If myCell.Value < "" Then
If IsError(Application.Match(myCell.Value, _
BaseSheet.Range("1:1"), False)) Then
With BaseSheet.Range("IV1").End(xlToLeft)(1, 2)
..Value = myCell.Value
myColumn = .Column
End With
Else
myColumn = Application.Match(myCell.Value, _
BaseSheet.Range("1:1"), False)
End If

For Each myCell2 In Intersect(Range("A2:A65536"), _
ActiveSheet.UsedRange)
If IsError(Application.Match(myCell2.Value, _
BaseSheet.Range("A:A"), False)) Then
With BaseSheet.Range("A65536").End(xlUp)(2)
..Value = myCell2.Value
myRow = .Row
End With
Else
myRow = Application.Match(myCell2.Value, _
BaseSheet.Range("A:A"), False)
End If

BaseSheet.Cells(myRow, myColumn).Value = _
Cells(myCell2.Row, myCell.Column).Value
Next myCell2
End If
Next myCell
End If
NextSheet:
Next mySht

ActiveWorkbook.SaveAs Application.GetSaveAsFilename("Consolidated.xls")

With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With

End Sub


"Steve Lewington" <Steve wrote in message
...
I have to combine some worksheets that have slightly different information in
them, to a single worksheet. Most of the columns are the same with the
exception of an odd column, and there a numerous additional rows that would
need to be added.

No one worksheet has at this stage got priority over another.

Any assistance in how to do this would be greatfully received.

Steve

Bernie,

I too need to combine spreadsheets and found this thread from Dec. I copied
the macro and tried to run but got a syntax error on the ..Value =
myCell2.Value lines. Being VBA illiterate did I misinterpret or misread your
instructions?

Best regards,
Kem

"Bernie Deitrick" wrote:

Steve,

Put all the worksheets into the same workbook, if they aren't already, and then run the macro below.

It will combine the databases from all the sheets in a workbook, based on the field names in row 1
and the key values in column A. Note that you would need to have the same value in cell A1 of all
sheets, each table must start in cell A1, and be contiguous (no completely blank rows or columns).
For those fields that differ, the fields are left blank for the models that lack the information.

HTH,
Bernie
MS Excel MVP


Sub ConsolidateDatabasesMultiSheets()
Dim BaseBook As Workbook
Dim BaseSheet As Worksheet
Dim myBook As Workbook
Dim mySht As Worksheet
Dim myCell As Range
Dim myCell2 As Range
Dim myColumn As Integer
Dim myRow As Long
Dim FirstCopy As Boolean

FirstCopy = True

With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With

Set BaseSheet = Worksheets.Add
ActiveSheet.Name = "Combined"
For Each mySht In ActiveWorkbook.Worksheets
If mySht.Name < BaseSheet.Name Then
If FirstCopy Then
mySht.Cells.Copy BaseSheet.Range("A1")
FirstCopy = False
GoTo NextSheet:
End If
mySht.Activate
myRow = BaseSheet.UsedRange.Rows.Count + 1
For Each myCell In Intersect(Range("1:1"), _
ActiveSheet.UsedRange)
If myCell.Value < "" Then
If IsError(Application.Match(myCell.Value, _
BaseSheet.Range("1:1"), False)) Then
With BaseSheet.Range("IV1").End(xlToLeft)(1, 2)
..Value = myCell.Value
myColumn = .Column
End With
Else
myColumn = Application.Match(myCell.Value, _
BaseSheet.Range("1:1"), False)
End If

For Each myCell2 In Intersect(Range("A2:A65536"), _
ActiveSheet.UsedRange)
If IsError(Application.Match(myCell2.Value, _
BaseSheet.Range("A:A"), False)) Then
With BaseSheet.Range("A65536").End(xlUp)(2)
..Value = myCell2.Value
myRow = .Row
End With
Else
myRow = Application.Match(myCell2.Value, _
BaseSheet.Range("A:A"), False)
End If

BaseSheet.Cells(myRow, myColumn).Value = _
Cells(myCell2.Row, myCell.Column).Value
Next myCell2
End If
Next myCell
End If
NextSheet:
Next mySht

ActiveWorkbook.SaveAs Application.GetSaveAsFilename("Consolidated.xls")

With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With

End Sub


"Steve Lewington" <Steve wrote in message
...
I have to combine some worksheets that have slightly different information in
them, to a single worksheet. Most of the columns are the same with the
exception of an odd column, and there a numerous additional rows that would
need to be added.

No one worksheet has at this stage got priority over another.

Any assistance in how to do this would be greatfully received.

Steve