Copy range on multiple sheets into one sheet

[Joe_Hunt via OfficeKB.com]

Hello,
I have a summary sheet that up until this morning worked just great. It
deleted the current sheet, added another, and transferred all the data.
Somebody other than me will be using it now though, and I'd like to make it a
little more user friendly. I have the coding except for the part where it
loops through and picks the data up. Below is the first part of the coding
from when it deleted the worksheet. How can I modify that to just grab the
data and put it on there? I appreciate any help.

Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim CopyRng As Range

Application.ScreenUpdating = False
Application.EnableEvents = False

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

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

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

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

'Fill in the range that you want to copy
Set CopyRng = sh.Range("L11:V93")

'Test if there enough rows in the DestSh to copy all the data
If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
MsgBox "There are not enough rows in the Destsh"
GoTo ExitTheSub
End If

'This copies all values/formats

With CopyRng
DestSh.Cells(Last + 1, "A").Resize(.Rows.Count, _
.Columns.Count).Value = .Value
End With

End If
Next

ExitTheSub:

Application.GoTo DestSh.Cells(1)

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

Application.EnableEvents = True

 

[Ron de Bruin]

Hi Joe

I am not sure what you want
Do you want to copy the data on the Exceptions sheet below the data that is already on that sheet ?

 

[Joe_Hunt via OfficeKB.com]

Sorry, I'm sometimes not very good at explaining. things. I'd like to copy
the data from cells L11:V93 from every other worksheet in the workbook into
the Exceptions sheet. I can manipulate it from there. I appreciate your help.

Hi Joe

I am not sure what you want
Do you want to copy the data on the Exceptions sheet below the data that is already on that sheet ?

Hello,
I have a summary sheet that up until this morning worked just great. It

[quoted text clipped - 58 lines]

Application.EnableEvents = True

 

[Ron de Bruin]

Is this not working for you then ?
http://www.rondebruin.nl/copy2.htm

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm

Sorry, I'm sometimes not very good at explaining. things. I'd like to copy
the data from cells L11:V93 from every other worksheet in the workbook into
the Exceptions sheet. I can manipulate it from there. I appreciate your help.

Hi Joe

I am not sure what you want
Do you want to copy the data on the Exceptions sheet below the data that is already on that sheet ?

Hello,
I have a summary sheet that up until this morning worked just great. It

[quoted text clipped - 58 lines]

Application.EnableEvents = True

 

[Joe_Hunt via OfficeKB.com]

Looks a lot like what I have. I took some coding from another workbook and
modified it, so maybe your site is where it originated (I think I have a book
at home with an author by your name. Is that you?). After this though the
worksheet is manipulated to gather the information into a coherent form, and
some calculations are done with it. I'd like this process to be kicked off by
changing a percentage in a specified cell (all that begins in the next set of
instructions), and to make that work I need to gather this information
without deleting the sheet, I guess, by having a change event in the coding
of the worksheet. My thought was just to clear the information existing in
the worksheet and then gathering what I needed from the other worksheets. I
was trying not to make my original post too long.

Is this not working for you then ?
http://www.rondebruin.nl/copy2.htm

Sorry, I'm sometimes not very good at explaining. things. I'd like to copy
the data from cells L11:V93 from every other worksheet in the workbook into

[quoted text clipped - 10 lines]

 

[Ron de Bruin]

No Book from me but maybe you seen my article on MSDN

I will reply tomorrow with a example that clear the cells on the Exceptions sheet instead
of deleting the sheet.

Bed time for me now



--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm

Looks a lot like what I have. I took some coding from another workbook and
modified it, so maybe your site is where it originated (I think I have a book
at home with an author by your name. Is that you?). After this though the
worksheet is manipulated to gather the information into a coherent form, and
some calculations are done with it. I'd like this process to be kicked off by
changing a percentage in a specified cell (all that begins in the next set of
instructions), and to make that work I need to gather this information
without deleting the sheet, I guess, by having a change event in the coding
of the worksheet. My thought was just to clear the information existing in
the worksheet and then gathering what I needed from the other worksheets. I
was trying not to make my original post too long.

Is this not working for you then ?
http://www.rondebruin.nl/copy2.htm

Sorry, I'm sometimes not very good at explaining. things. I'd like to copy
the data from cells L11:V93 from every other worksheet in the workbook into

[quoted text clipped - 10 lines]

Application.EnableEvents = True

 

[Joe_Hunt via OfficeKB.com]

Thanks!

No Book from me but maybe you seen my article on MSDN

I will reply tomorrow with a example that clear the cells on the Exceptions sheet instead
of deleting the sheet.

Bed time for me now

Looks a lot like what I have. I took some coding from another workbook and
modified it, so maybe your site is where it originated (I think I have a book

[quoted text clipped - 16 lines]

 

[Ron de Bruin]

Hi Joe

Try this one together with the lastrow function.
It will copy from row 2 till the last row with data of each sheet

Sub CopyDataWithoutHeaders()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim shLast As Long
Dim CopyRng As Range
Dim StartRow As Long

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

'Clear the data on "Exceptions", it will not delete row 1 this example
Set DestSh = ActiveWorkbook.Worksheets("Exceptions")
DestSh.Rows("2:" & Rows.Count).Clear

'Fill in the start row
StartRow = 2

'loop through all worksheets and copy the data to the DestSh
For Each sh In ActiveWorkbook.Worksheets

'Loop through all worksheets except the RDBMerge worksheet and the
'Information worksheet, you can ad more sheets to the array if you want.
If IsError(Application.Match(sh.Name, _
Array(DestSh.Name, "Exceptions"), 0)) Then

'Find the last row with data on the DestSh and sh
Last = LastRow(DestSh)
shLast = LastRow(sh)

'If sh is not empty and if the last row >= StartRow copy the CopyRng
If shLast > 0 And shLast >= StartRow Then

'Set the range that you want to copy
Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast))

'Test if there enough rows in the DestSh to copy all the data
If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
MsgBox "There are not enough rows in the Destsh"
GoTo ExitTheSub
End If

'This example copies values/formats, if you only want to copy the
'values or want to copy everything look below example 1 on this page
CopyRng.Copy
With DestSh.Cells(Last + 1, "A")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With

End If

End If
Next

ExitTheSub:

Application.GoTo DestSh.Cells(1)

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

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


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm

Thanks!

No Book from me but maybe you seen my article on MSDN

I will reply tomorrow with a example that clear the cells on the Exceptions sheet instead
of deleting the sheet.

Bed time for me now

Looks a lot like what I have. I took some coding from another workbook and
modified it, so maybe your site is where it originated (I think I have a book

[quoted text clipped - 16 lines]

Application.EnableEvents = True

 

[Joe_Hunt via OfficeKB.com]

That did it. Thanks for your help!

Hi Joe

Try this one together with the lastrow function.
It will copy from row 2 till the last row with data of each sheet

Sub CopyDataWithoutHeaders()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim shLast As Long
Dim CopyRng As Range
Dim StartRow As Long

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

'Clear the data on "Exceptions", it will not delete row 1 this example
Set DestSh = ActiveWorkbook.Worksheets("Exceptions")
DestSh.Rows("2:" & Rows.Count).Clear

'Fill in the start row
StartRow = 2

'loop through all worksheets and copy the data to the DestSh
For Each sh In ActiveWorkbook.Worksheets

'Loop through all worksheets except the RDBMerge worksheet and the
'Information worksheet, you can ad more sheets to the array if you want.
If IsError(Application.Match(sh.Name, _
Array(DestSh.Name, "Exceptions"), 0)) Then

'Find the last row with data on the DestSh and sh
Last = LastRow(DestSh)
shLast = LastRow(sh)

'If sh is not empty and if the last row >= StartRow copy the CopyRng
If shLast > 0 And shLast >= StartRow Then

'Set the range that you want to copy
Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast))

'Test if there enough rows in the DestSh to copy all the data
If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
MsgBox "There are not enough rows in the Destsh"
GoTo ExitTheSub
End If

'This example copies values/formats, if you only want to copy the
'values or want to copy everything look below example 1 on this page
CopyRng.Copy
With DestSh.Cells(Last + 1, "A")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With

End If

End If
Next

ExitTheSub:

Application.GoTo DestSh.Cells(1)

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

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

Thanks!

[quoted text clipped - 10 lines]