Consolidating selected data from multiple worksheets into new worksheet

DeonM

New Member
Joined
Sep 18, 2014
Messages
26
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.
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
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).
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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)
 
Upvote 0
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 :)
 
Upvote 0

Forum statistics

Threads
1,213,535
Messages
6,114,192
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top