ExcelBanter - Relative cells in different sheets in same workbook

Try this one to copy the row from the activecell
Add a worksheet to your workbook first with the name "Collect"

Sub Test1()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim r As Long
r = ActiveCell.Row
Application.ScreenUpdating = False
Set DestSh = Sheets("Collect")
For Each sh In ThisWorkbook.Worksheets
If sh.Name < DestSh.Name Then
Last = LastRow(DestSh) + 1
sh.Rows(r).Copy DestSh.Cells(Last, "A")
End If
Next
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

More information here
http://www.rondebruin.nl/copy2.htm

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

"Lorence" wrote in message ...
Until I can get it into Access, I need to use a workbook for work,
with 10 sheets in it.

To collect data I want to select a range (relative to the cursor) and
then select the same range from each sheet, copying each line to a
single sheet in the same, or a different w/book

On the next day, I would position the cursor down one line and repeat
the exercise to generate historical data on one sheet

Help!!

Lorence