Consolidate data from multiple worksheets into one

[Guest]

I have a workbook with multiple worksheets representing different
departments. The colum headings are exactly the same for each department. I
want to create a main worksheet that includes all data from these different
worksheets, however, this is a "live" workbook that will have new data
entered on a consistant basis. Is it possible to have a worksheet that is
autopopulated with the new data as it is entered to the other worksheets??

 

[Bernie Deitrick]

Barton,

Bite the bullet, and get rid of all the extra sheets: use just one sheet, with another column
denoting the department (use the sheet names from the old workbook). Then enter the data with that
one extra field, and use filters and/or pivot tables to display/ use your data. The macro below
will create the database for you from your existing workbook. It assumes that all your sheets start
in cell A1, all have the same headers (in row 1), and the same column arrangement. After running
the macro, delete the original sheets and save the file under a different name.

HTH,
Bernie
MS Excel MVP

Sub ConsolidateSheetsIntoDataBase()
With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With

Dim i As Integer
Dim myDB As Worksheet

Set myDB = Worksheets.Add(Before:=Worksheets(1))
myDB.Name = "DataBase Sheet"

Worksheets(2).Cells.Copy Worksheets(1).Cells

With Worksheets(1)
.Cells(1, 1).EntireColumn.Insert
.Cells(1, 1).Value = "Department"
Intersect(.Range("A2:A" & .Rows.Count), .UsedRange).Value = Worksheets(2).Name
End With

For i = 3 To Worksheets.Count
With Worksheets(1)
myRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
Worksheets(i).Cells(1, 1).CurrentRegion.Copy Worksheets(1).Cells(myRow, 2)
Intersect(.Range("A" & myRow & ":A" & .Rows.Count), .UsedRange).Value = Worksheets(i).Name
End With
Next i

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


End Sub

 

[Bernie Deitrick]

Oops, I forgot to take the extra headers out... use this version.

HTH,
Bernie
MS Excel MVP

Sub ConsolidateSheetsIntoDataBase()
With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With

Dim i As Integer
Dim myDB As Worksheet

Set myDB = Worksheets.Add(Before:=Worksheets(1))
myDB.Name = "DataBase Sheet"

Worksheets(2).Cells.Copy Worksheets(1).Cells

With Worksheets(1)
.Cells(1, 1).EntireColumn.Insert
.Cells(1, 1).Value = "Department"
Intersect(.Range("A2:A" & .Rows.Count), _
.UsedRange).Value = Worksheets(2).Name
End With

For i = 3 To Worksheets.Count
With Worksheets(1)
myRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
Worksheets(i).Cells(1, 1).CurrentRegion.Offset(1) _
.Copy Worksheets(1).Cells(myRow, 2)
Intersect(.Range("A" & myRow & ":A" & .Rows.Count), _
.UsedRange).Value = Worksheets(i).Name
End With
Next i

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

End Sub