Copying same range from multiple sheet to a new sheet

Hi Andrea

Here is a Macro that will do the job for you.

Sub CopyRanges()
'Written by Ozgrid Business Applications
'www.ozgrid.com
Dim rCopyCells As Range
Dim wWsht As Worksheet

On Error Resume Next
Set rCopyCells = Application.InputBox _
(Prompt:="Select a range", Type:=8)

If rCopyCells Is Nothing Then Exit Sub

For Each wWsht In ActiveWorkbook.Worksheets
Select Case wWsht.Name
Case "Sheet1", "Sheet2", "Sheet3"
wWsht.Range(rCopyCells.Address).Copy Destination:= _
Sheets("Total").Range("A65536").End(xlUp)
End Select
Next wWsht
Set rCopyCells = Nothing
End Sub

To use it:

Push Alt+F11 and go to Insert>Module.
Paste in the code.
Change "Sheet1" etc to the names you want.
Push Alt+Q then Push Alt+F8.
Select "CopyRanges" and click "Options"
Assign a shortcut key.

Now, select any sheet and holding down you Ctrl key select the Sheets you want the range Copied from.
Push the Shortcut key and select the range on the sheet you are on.
Click OK

Dave.
OzGrid Business Applications

Hi Dave,
I notice that using your macro I miss the last row of each range(except the last sheet selected). Can you help me?

Thanks

To use it: Push Alt+F11 and go to Insert>Module.

Revised line :-
wWsht.Range(rCopyCells.Address).Copy Destination:= _
Sheets("Total").Range("A65536").End(xlUp).Offset(1,0)

Hi Dave,
now it's all OK, Thanks. I have a problem with a workbook with 175 Sheets I changed your line:
Case "Sheet1", "Sheet2", "Sheet3"
in
Case "xxx" To "yyy",
where xxx and yyy are sample name, unfortunately it doesn't work well.
Can you suggest me a way to change the macro in order I can select the range and the sheets to copy in "Total"?

Thank you for your help Andrea