Copy range on multiple sheets into one sheet
 

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

--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...mming/200905/1

Copy range on multiple sheets into one sheet
 

hi Joe,

I'm not sure exactly what you're asking so I've made some changes
(removing the sheet deletion code, adjusting With statements etc)...

I am guessing that you want to prevent the potential need for changing
the copyrng in the VBE screen, which is currently coded as
Code:
--------------------
Set CopyRng = sh.Range("L11:V93")
--------------------

How is this range defined...?

- Does it always start in row 11?
- Does it always start in column L?

What defines the endpoint... (last Row & last column, or first blank
row after row 11)?
Could a user select the range easily (once, at the start of the code)?
If so, try:



Code:
--------------------
Option Explicit
Sub ModifiedVersion()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim CopyRng As Range
Dim CopyRngAddrs As String

CopyRngAddrs = Application.InputBox(prompt:="Please select copy range", Title:="MACRO REQUEST", Type:=8).Address

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

'rely on Exception sheet already existing
Set DestSh = ActiveWorkbook.Worksheets("Exceptions")
DestSh.UsedRange.ClearContents

'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")
'### line added
Set CopyRng = sh.Range(CopyRngAddrs)
With CopyRng
'Test if there enough rows in the DestSh to copy all the data
If Last + .Rows.Count DestSh.Rows.Count Then
MsgBox "There are not enough rows in the Destsh"
GoTo ExitTheSub
End If
'This copies all values/formats
DestSh.Cells(Last + 1, "A").Resize(.Rows.Count, _
.Columns.Count).Value = .Value
End With
End If
Next

ExitTheSub:
'AutoFit the column width in the DestSh sheet
DestSh.Columns.AutoFit
With Application
.GoTo DestSh.Cells(1)
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub

--------------------


hth
Rob


--
broro183

Rob Brockett. Always learning & the best way to learn is to
experience...
------------------------------------------------------------------------
broro183's Profile: http://www.thecodecage.com/forumz/member.php?userid=333
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=101770

Copy range on multiple sheets into one sheet
 

Thanks for your help!

broro183 wrote:
hi Joe,

I'm not sure exactly what you're asking so I've made some changes
(removing the sheet deletion code, adjusting With statements etc)...

I am guessing that you want to prevent the potential need for changing
the copyrng in the VBE screen, which is currently coded as
Code:
--------------------
Set CopyRng = sh.Range("L11:V93")
--------------------

How is this range defined...?

- Does it always start in row 11?
- Does it always start in column L?

What defines the endpoint... (last Row & last column, or first blank
row after row 11)?
Could a user select the range easily (once, at the start of the code)?
If so, try:

Code:
--------------------
Option Explicit
Sub ModifiedVersion()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim CopyRng As Range
Dim CopyRngAddrs As String

CopyRngAddrs = Application.InputBox(prompt:="Please select copy range", Title:="MACRO REQUEST", Type:=8).Address

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

'rely on Exception sheet already existing
Set DestSh = ActiveWorkbook.Worksheets("Exceptions")
DestSh.UsedRange.ClearContents

'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")
'### line added
Set CopyRng = sh.Range(CopyRngAddrs)
With CopyRng
'Test if there enough rows in the DestSh to copy all the data
If Last + .Rows.Count DestSh.Rows.Count Then
MsgBox "There are not enough rows in the Destsh"
GoTo ExitTheSub
End If
'This copies all values/formats
DestSh.Cells(Last + 1, "A").Resize(.Rows.Count, _
.Columns.Count).Value = .Value
End With
End If
Next

ExitTheSub:
'AutoFit the column width in the DestSh sheet
DestSh.Columns.AutoFit
With Application
.GoTo DestSh.Cells(1)
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub

--------------------

hth
Rob


--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...mming/200906/1

Copy range on multiple sheets into one sheet
 

hi Joe,

Thanks for the feedback - are all your questions/problems answered for
this thread?

Rob


--
broro183

Rob Brockett. Always learning & the best way to learn is to
experience...
------------------------------------------------------------------------
broro183's Profile: http://www.thecodecage.com/forumz/member.php?userid=333
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=101770

Copy range on multiple sheets into one sheet
 

hi Joe,

Thanks for the feedback - are all your questions/problems answered for
this thread?

Rob


--
broro183

Rob Brockett. Always learning & the best way to learn is to
experience...
------------------------------------------------------------------------
broro183's Profile: http://www.thecodecage.com/forumz/member.php?userid=333
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=101770

Copy range on multiple sheets into one sheet
 

Yes, thank you much!

broro183 wrote:
hi Joe,

Thanks for the feedback - are all your questions/problems answered for
this thread?

Rob


--
Message posted via http://www.officekb.com