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
 

Some videos you may like

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.

excelnovice05

Board Regular
Joined
Jan 4, 2005
Messages
66
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.
 

VoG

Legend
Joined
Jun 19, 2002
Messages
63,651
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.
 

excelnovice05

Board Regular
Joined
Jan 4, 2005
Messages
66
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
 

VoG

Legend
Joined
Jun 19, 2002
Messages
63,651
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
 

excelnovice05

Board Regular
Joined
Jan 4, 2005
Messages
66
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
 

excelnovice05

Board Regular
Joined
Jan 4, 2005
Messages
66
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
 

Watch MrExcel Video

Forum statistics

Threads
1,099,460
Messages
5,468,777
Members
406,608
Latest member
G3TEN

This Week's Hot Topics

Top