Macro: Consolidate Data from 10 Worksheets to 1

excelnovice05

Board Regular
Joined
Jan 4, 2005
Messages
66
I am trying to take a workbook with 10 worksheets and have the contents copied and pasted into a new worksheet without any extra blank rows onto a new spreadsheet. Does anyone know how to achieve this? The purpose is to copy the information off each of the 10 worksheets and be able to use the consolidated information for pivot tables.

Thanks in advance for any and all input....

The Novice

Important Facts:
- Each worksheet starts with data in cell A7 and ends at BL7
- The number of rows on each worksheet is inconsistent (e.g. one sheet ends at row 12 another at row 101)
- The columns have uniform titles and data below
 

Excel Facts

What is the last column in Excel?
Excel columns run from A to Z, AA to AZ, AAA to XFD. The last column is XFD.
Is there any way to limit the number of rows that will be conslidated into the spreadsheet? I have validations on the bottom of the each worksheet and they are being consolidated too. Otherwise VoG's method has worked perfectly. Thanks.
 
Upvote 0
I assume that you are using

Rich (BB code):
Set CopyRng = sh.UsedRange

Try changing that to

Rich (BB code):
Set CopyRng = sh.UsedRange.Resize(sh.UsedRange.Rows.Count - 1)

Change the 1 to the number of rows to be skipped at the bottom of the sheet.
 
Upvote 0
I ended up using the following macro (below) to consolidate the 10 worksheets into 1. I just ran across a problem - the formulas are copied in the cells with references. The references are to the consolidated sheet which changes the values considerablly. Is there any way to copy the information on the worksheets as values, therefore avoiding the references problem?

Option Explicit
Sub ConsolidateSheets()
'Merge all sheets in a workbook into one summary sheet (stacked)
Dim cs As Worksheet, ws As Worksheet, LR As Long, NR As Long
Application.ScreenUpdating = False

Set cs = Sheets("Consolidation")
cs.Activate
Range("A2:BL" & Rows.Count).Delete

For Each ws In Worksheets
If ws.Name <> "Consolidation" Then
NR = cs.Range("A" & Rows.Count).End(xlUp).Row + 1
LR = ws.Range("A" & Rows.Count).End(xlUp).Row
ws.Range("A7:BL" & LR).Copy cs.Range("A" & NR)
End If
Next ws

Application.ScreenUpdating = True
End Sub

The Novice
 
Upvote 0
Try

Code:
Sub ConsolidateSheets()
'Merge all sheets in a workbook into one summary sheet (stacked)
Dim cs As Worksheet, ws As Worksheet, LR As Long, NR As Long
Application.ScreenUpdating = False
Set cs = Sheets("Consolidation")
cs.Activate
Range("A2:BL" & Rows.Count).Delete
For Each ws In Worksheets
    If ws.Name <> "Consolidation" Then
        NR = cs.Range("A" & Rows.Count).End(xlUp).Row + 1
        LR = ws.Range("A" & Rows.Count).End(xlUp).Row
        ws.Range("A7:BL" & LR).Copy
        cs.Range("A" & NR).PasteSpecial Paste:=xlPasteValues
    End If
Next ws
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Thanks for the insight. It works well.

One last question (fingers-crossed), I have eight pivot tables with different information that needs to be refreshed. Based upon the fact that the current code deletes the rows before copy and pasting, the references in the pivot tables are lost. Is there any way to either not delete the values and/or have the references reset based upon the new conlidated information on that worksheet?

Here is the code on the consolidation worksheet:

Sub ConsolidateSheets()
'Merge all sheets in a workbook into one summary sheet (stacked)
Dim cs As Worksheet, ws As Worksheet, LR As Long, NR As Long
Application.ScreenUpdating = False
Set cs = Sheets("Consolidation")
cs.Activate
Range("A2:BL" & Rows.Count).Delete
For Each ws In Worksheets
If ws.Name <> "Consolidation" Then
NR = cs.Range("A" & Rows.Count).End(xlUp).Row + 1
LR = ws.Range("A" & Rows.Count).End(xlUp).Row
ws.Range("A7:BL" & LR).Copy
cs.Range("A" & NR).PasteSpecial Paste:=xlPasteValues
End If
Next ws
Application.ScreenUpdating = True
End Sub


Here is the code on the pivot table worksheets:

Private Sub Worksheet_Activate()
ActiveWorkbook.RefreshAll
End Sub
 
Upvote 0
I was able to change "Range("A2:BL" & Rows.Count).Delete" to "Range("A2:BL" & Rows.Count).ClearContents" to keep the references within the pivot tables. One minor problem is that the pivot tables now include a "(blank)" column where the reference does not have data. Any thoughts on how to get ride of that?

Thanks,
The Novice
 
Upvote 0

Forum statistics

Threads
1,223,275
Messages
6,171,122
Members
452,381
Latest member
Nova88

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