How to consolidate multiple worksheets into one.

[Guest]

I've got a series of spreadsheets that I need to do some work on but in order
to do it I need to consolidate all of the data into a single worksheet first.

What I'm looking for is something like a macro that that will look at my
workbook, read all of the sheets and then append the data from all of the
sheets into a new single worksheet - presumably as the first sheet of the
workbook but that's not important.

The good news is that all of the sheets will have the same number of columns
(from A:U), but the bad news is that the number of sheets could vary from
workbook to workbook (which isn't the end of the world because I can make
slight modifications to the macro to take into account the number of sheets -
but ideally I'd just like to have one macro that reads all of the sheets and
requires no changing as I might not be maintaining things in the longer term)
and of course the really bad news is that the number of rows of data will
vary wildly and will change from run to run as new records are added and old
ones are removed.

Is that a tough ask? An easy ask? An impossible ask?

Any help would be absolutely fantastically received from this doddery old
Bovine that needs some assistance desperately!

Thanks.

 

[Ron de Bruin]

Hi Bovine

See this page
http://www.rondebruin.nl/copy2.htm

 

[Roger Govier]

Hi

The following code will look for a sheet called Summary.
If there is any data on the sheet, it will delete everything from row2
down to the end of the sheet, preserving the headers in row 1.
It will then cycle though all sheets in the workbook, adding data from
row 2 to the end of data on that sheet between columns A and U, and
append it to data on the Summary sheet.

The procedure assumes that column A will always have data in it for each
row required, and this is the column that is used for counting the
number of used rows on each sheet. If that is not the case, then you
will need to amend the column number according in the lines containing

Cells(Rows.Count, 1).End(xlUp).Row - change the 1 for column A to the
number of the column to be used for the count.



Sub ColateData()

Dim Dsheet As Worksheet, Ssheet As Worksheet
Dim addrow As Long, lastrow As Long
Dim source As Range, dest As Range

Application.ScreenUpdating = False
ThisWorkbook.Sheets("Summary").Select
Set Ssheet = ThisWorkbook.Sheets("Summary")
With Ssheet
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
If lastrow = 1 Then lastrow = 2
Rows("2:" & lastrow).Clear
End With

For Each Dsheet In Worksheets
With Ssheet
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
End With

If Dsheet.Name <> "Summary" Then
addrow = Dsheet.Cells(Rows.Count, 1).End(xlUp).Row
Set source = Dsheet.Range("A2:U" & addrow)
Set dest = Ssheet.Range("A" & lastrow + 1)
source.Copy dest
End If
Next

Application.ScreenUpdating = True
End Sub


You can copy the code and paste it into your Visual Basic Editor
(VBE) in a Standard Module located in your file.

To do this,

Alt + F11 (open VBE)
Ctrl + R (open Project Explorer)
Select the file name on the left
Insert > Module
Paste code in Module

For more information on adding code to a Workbook then David McRitchie
has lots of useful help on his site at
http://www.mvps.org/dmcritchie/excel/install.htm
http://www.mvps.org/dmcritchie/excel/getstarted.htm

 

[Guest]

Ron

This looks quite promising but I get an error of a Sub or Function not
defined on lastrow. Have I done something wrong?

Thanks

BJ

 

[Guest]

Roger

This is almost, so close to being perfect... but for some reason it flashes
up various save file screens while it's doing it that need responses to
(which in every case has been cancel.)

Once it's done that it works fantastically.

Any suggestions?

Thanks.

BJ.

 

[Roger Govier]

Hi BJ

Maybe you have some other code running within the workbook, as I don't
experience what you are saying.

Try putting
Application.EnableEvents = False
on the line before
Application.ScreenUpdating = False
..
..
and then
..
Application.EnableEvents = True
after
Application.ScreenUpdating = True

 

[Jim May]

Also, from Help:

This example closes the workbook Book1.xls and doesn't prompt the user
to save changes. Any changes to Book1.xls aren't saved.

Application.DisplayAlerts = False
Workbooks("BOOK1.XLS").Close
Application.DisplayAlerts = True

In addition to Roger's comments..

 

[Guest]

Roger

Cracked it! It's because the macro when it's run is looking at the
spreadsheet and sees that it is referencing links to spreadsheets that don't
exist. Break the links and it works perfectly. Many many thanks.

Now just one final question... is it possible so that when I paste it's
pasted as values only (without the formatting?)

Then I promise I'll leave you alone!

 

[Guest]

Thanks Jim. You'll see from my last update that it was an inheriting files
with dodgy links thing that's now fixed.

 

[Roger Govier]

Hi BJ

One way

After the Next statement, and before Application.ScreenUpdating = True,
and the following

With Ssheet
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
Range("A2:U" & lastrow).Value = Range("A2:U" & lastrow).Value
End With

 

[Ron de Bruin]

Read the page good

Copy the lastrow function also in the module

 

[Guest]

Ahhhh it all makes sense now.

Thanks Ron.

Read the page good

Copy the lastrow function also in the module

 

[Guest]

That is fantastic. Thanks Roger.

Hi BJ

One way

After the Next statement, and before Application.ScreenUpdating = True,
and the following

With Ssheet
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
Range("A2:U" & lastrow).Value = Range("A2:U" & lastrow).Value
End With

 

[Laila]

Ron,

This works really well with my workbook but I wanted it to be able to paste
the data from all worksheets into 1 column (as opposed to different columns
for each worksheet).

I tried the following which didn't work. Can you help me figure it out?

I changed this:
'Find the last Column with data on the DestSh
Last = LastCol(DestSh)

To this:
'Find the last row with data on the DestSh and sh
Last = LastRow(DestSh)
Last = Last + 1

And changed this:
CopyRng.Copy
With DestSh.Cells(1, Last + 1)
.PasteSpecial 8 ' Column width
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With

To this:
CopyRng.Copy
With DestSh.Cells(Last, 1)
.PasteSpecial 8 ' Column width
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With

Thanks!

 

[Ron de Bruin]

Hi Laila

Read the page good
http://www.rondebruin.nl/copy2.htm

First two are for below each other and the third next to each other

 

[Tinker]

Ron,

I have a similar problem to Bovine's but with a slightly different twist. I
need to copy several ranges from multiple worksheets to a single page. The
difference is that the ranges, which is say 1 10x10 area each, vary in
number on each sheet and are seperated by blank spaces. Good thing is they
are always the exact same difference apart. I assume some sort of offset
function may work but have been able to get there yet.

 

[Ron de Bruin]

Hi Tinker

If there is a empty row/column between them you can use

ActiveCell.CurrentRegion

Do you know the first cell of each range ?

We need more info to help you
Bed time form me so it will be tomorrow after work before I can reply