Consolidating selected data from multiple worksheets into new worksheet

DeonM

New Member
Joined
Sep 18, 2014
Messages
25
I have a workbook containing 278 worksheets. Each worksheet has exactly the same format (row and column headers and layout). I want to create a new consolidated sheet that consolidates data from selected cells (by cell location) from each worksheet. (Without having to do the manually as it will be a regular task.)

The current worksheet names are unique identifiers and need to be used as the column headers in new sheet.

The consolidated sheet will ideally look like this:

+Name/Worksheet1+Name/Worksheet2+Name/Worksheet3Etc
+Worsheet1!b3+Worsheet2!b3+Worsheet3!b3Etc
+Worsheet1!b4+Worsheet2!b4+Worsheet3!b4Etc
+Worsheet1!b5+Worsheet2!b5+Worsheet3!b5Etc
+Worsheet1!b6+Worsheet2!b6+Worsheet3!b6Etc
+Worsheet1!b7+Worsheet2!b7+Worsheet3!b7Etc
+Worsheet1!b8+Worsheet2!b8+Worsheet3!b8Etc
EtcEtcEtcEtc

<tbody>
</tbody>

I’m using Excel 2010.
 

Some videos you may like

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.

Oeldere

Well-known Member
Joined
Dec 29, 2011
Messages
2,213
I personly think you are better of using the sheetname as an row (instead of a column => (header)), and the data of your 278 sheets in the same format as they are.

I think that will make it much easier to anlyse the data (after the consolidation).
 

DeonM

New Member
Joined
Sep 18, 2014
Messages
25
Thank you. I've basically got it to work. From my result so far I would be able to achieve what I need to do (by creating a second lookup table). But there may be a way to just get the macro to do the job.

The current result pastes each value in a new row, each below the other.

Is it possible to paste the range (b5:b45) of sheet1 into the lastrow but instead paste the values from column B to column AP in the same row (i.e. transpose them into columns). Then move to the next row for the next sheet?

The code I'm using now looks like this:

Sub CopyRangeFromMultiWorksheets()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim CopyRng As Range


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


' Delete the summary sheet if it exists.
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("RDBMergeSheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True


' Add a new summary worksheet.
Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "RDBMergeSheet"


' Loop through all worksheets and copy the data to the
' summary worksheet.
For Each sh In ActiveWorkbook.Worksheets
If sh.Name <> DestSh.Name Then


' Find the last row with data on the summary worksheet.
Last = LastRow(DestSh)


' Specify the range to place the data.
Set CopyRng = sh.Range("b5:b45")


' Test to see whether there are enough rows in the summary
' worksheet to copy all the data.
If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
MsgBox "There are not enough rows in the " & _
"summary worksheet to place the data."
GoTo ExitTheSub
End If


' This statement copies values and formats from each
' worksheet.
CopyRng.Copy
With DestSh.Cells(Last + 1, "B")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With


' Optional: This statement will copy the sheet ' name in the A column.
DestSh.Cells(Last + 1, "A").Resize(CopyRng.Rows.Count).Value = sh.Name


End If
Next


ExitTheSub:


Application.Goto DestSh.Cells(1)


' AutoFit the column width in the summary sheet.
DestSh.Columns.AutoFit


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

DeonM

New Member
Joined
Sep 18, 2014
Messages
25

ADVERTISEMENT

Please ignore my other reply. I found the macro allowing me to merge columns into one summary sheet, which is exactly what I was trying to achieve.

It takes range B1:B45 from each sheet and adds them to the next column.

The only part I can't get to work is to put the name of each sheet in cells A1, B1, C1 etc above the data columns.

The code I'm using is this:

Sub CopyDataAfterLastColumnWithouTitles()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim CopyRng As Range

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


' Delete the summary worksheet if it exists.
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("RDBMergeSheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True


' Add a worksheet with the name "RDBMergeSheet"
Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "RDBMergeSheet"

' Loop through all worksheets and copy the data to the
' summary worksheet.
For Each sh In ActiveWorkbook.Worksheets
If sh.Name <> DestSh.Name Then


' Find the last column with data on the summary
' worksheet.
Last = LastCol(DestSh)


' Fill in the columns that you want to copy.
Set CopyRng = sh.Range("B1:B45")


' Test to see whether there enough rows in the summary
' worksheet to copy all the data.
If Last + CopyRng.Columns.Count > DestSh.Columns.Count Then
MsgBox "There are not enough columns in " & _
"the summary worksheet."
GoTo ExitTheSub
End If


' This statement copies values, formats, and the column width.
CopyRng.Copy
With DestSh.Cells(1, Last + 1)
.PasteSpecial 8 ' Column width
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With


End If
Next


ExitTheSub:


Application.Goto DestSh.Cells(1)


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

Andrew Poulsom

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
Try changing this:

Code:
With DestSh.Cells(1, Last + 1)

to:

Code:
DestSh.Cells(1, Last + 1).Value = sh.Name
With DestSh.Cells(2, Last + 1)
 

DeonM

New Member
Joined
Sep 18, 2014
Messages
25

ADVERTISEMENT

Thank you Andrew. Works perfectly.

I could work on it some more for formatting improvements etc but that is easily and quickly done manually.

Is there a book you'd could recommend as an intro to writing this type of macro? It would be good to get a basic understanding of what the code is actually doing, instead of just copying and pasting bits :)
 

Watch MrExcel Video

Forum statistics

Threads
1,109,161
Messages
5,527,156
Members
409,750
Latest member
BorisYeltsin

This Week's Hot Topics

Top