Richard,

This is untested. But maybe it'll give you an approach

Dim Sheetname as String
Dim SheetNumber as int
Dim LastSheetNumber as Int

SheetNumber = 1 ' starting sheet number
Do
SheetName = "Data" & SheetNumber
Sheets(SheetName).Select
Range("C5").Select
Selection.Copy
Sheets("ActivityData").Select
Cells(SheetNumber + 3 ,3)
ActiveSheet.Paste Link:=True
SheetNumber = SheetNumber + 1
Loop While SheetNumber <= LastSheetNumber

--
Earl Kiosterud
mvpearl omitthisword at verizon period net
-------------------------------------------

"Richard S" wrote in message
...
How do I write a macro which loops this ?

Sheets("Data1").Select
Range("C5").Select
Selection.Copy
Sheets("ActivityData").Select
Range("C4").Select
ActiveSheet.Paste Link:=True

Sheets("Data2").Select
Range("C5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("ActivityData").Select
Range("C5").Select
ActiveSheet.Paste Link:=True

Sheets("Data3").Select
Range("C5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("ActivityData").Select
Range("C6").Select
ActiveSheet.Paste Link:=True