I am trying to compile data from multiple worksheets into
a single worksheet. The ranges from the multiple sheet
vary from sheet to sheet. Also, rows in each sheet can be
added or deleted (i.e. the range in a sheet will not
always be the same.)

Does anyone know of code available that will accomplish
this task?

Thanks

Hi Eric

Try this
http://www.rondebruin.nl/copy2.htm

--
Regards Ron de Bruin
http://www.rondebruin.nl


"Eric" wrote in message ...
I am trying to compile data from multiple worksheets into
a single worksheet. The ranges from the multiple sheet
vary from sheet to sheet. Also, rows in each sheet can be
added or deleted (i.e. the range in a sheet will not
always be the same.)

Does anyone know of code available that will accomplish
this task?

Thanks

Do you have anything that will copy from only selected sheets. Forgive
me, I'm a VB novice.

Thanks



*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

Hi Eric

I change the first sub on the page for you.
Add a worksheet to the workbook first with the name "Master"

Copy the sub and the function in a normal module

Sub Test1()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long

Application.ScreenUpdating = False
Set DestSh = Worksheets("Master")
For Each sh In ActiveWindow.SelectedSheets
If sh.Name < DestSh.Name Then
Last = LastRow(DestSh)

sh.Range("A1:C5").Copy DestSh.Cells(Last + 1, "A")
'Instead of this line you can use the code below to copy only the values
'or use the PasteSpecial option to paste the format also.


'With sh.Range("A1:C5")
'DestSh.Cells(Last + 1, "A").Resize(.Rows.Count, _
'.Columns.Count).Value = .Value
'End With


'sh.Range("A1:C5").Copy
'With DestSh.Cells(Last + 1, "A")
' .PasteSpecial xlPasteValues, , False, False
' .PasteSpecial xlPasteFormats, , False, False
' Application.CutCopyMode = False
'End With

DestSh.Cells(Last + 1, "D").Value = sh.Name
'This will copy the sheet name in the D column if you want

End If
Next
Cells(1).Select
Application.ScreenUpdating = True
End Sub

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function




--
Regards Ron de Bruin
http://www.rondebruin.nl


"Eric Byers" wrote in message ...
Do you have anything that will copy from only selected sheets. Forgive
me, I'm a VB novice.

Thanks



*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!