This is how I used to do it with a separate routine for each sheet.

Sub Weeks()

Weeks4

Weeks5

Weeks6

Weeks7

Weeks8

Weeks9

Weeks10

Weeks11

Weeks12

Weeks13

Weeks14

Weeks15

Weeks16

Weeks17

Weeks18

Weeks19

Weeks20

Weeks21

Weeks22

End Sub

Sub Weeks4()

Dim r As Long 'this points to the worksheet row

Dim c As Long 'this points to the array column, not the worksheet column

Dim x As Integer

x = 4

Dim Sheet1Values As Variant

Sheet1Values = Worksheets(1).Range(Cells(x, 2), Cells(x, 8)).Resize(1,
7).Value

r = 7

c = 1

WeekNum r, c, 13, Sheet1Values



Sheet1Values = Worksheets(1).Range(Cells(x, 9), Cells(x, 15)).Resize(1,
7).Value

r = 17

c = 1

WeekNum r, c, 23, Sheet1Values

End Sub

Sub WeekNum(r As Long, c As Long, maxR As Long, SheetValues)

Dim rng As Range



With Worksheets(4)



Do While r <= maxR



Set rng = .Cells(r, 3).Resize(1, 5)

Select Case SheetValues(1, c)



Case 0

rng.Value = Array(0, 0, 0, "RDO", 0)

Case "a", "e"

rng.Value = Array("9:00", "17:21", "0:45", 0, 0)



End Select



r = r + 1

c = c + 1



Loop

End With



End Sub





"Bob Phillips" wrote in message
...
Hi Max,


"Max Bialystock" wrote in message
...
Hi Bob,
Sorry to trouble you again.

Run like as amended below it works perfectly.

If the array is expanded to include 5 6 7 8 whatever happens to sheet 8
happens to each sheet.

What I need to happen is that the data in row 4 of sheet 1 winds up in
sheet
4 and the data in row 5 of sheet 1 in sheet 5 and so on.

If you've had enough of this now, I'll understand.

Get out of here! We'll crack it.

The biggest difficulty I have is envisaging eaxctly what you arev trying
to
do, as I obviously don't have the data or the requirements as you know
them.

Having said that, the Weeks procedure looks wrong. Try this variation and
let me know.

Sub Weeks(x As Long, sh As Worksheet)
Dim r As Long 'this points to the worksheet row
Dim c As Long 'this points to the array column, not the worksheet column
Dim SheetValues As Variant

With Worksheets(1)
SheetValues = .Range(.Cells(x, 2), .Cells(x, 8)).Resize(1,
7).Value
WeekNum 7, 1, 13, SheetValues, sh
SheetValues = .Range(.Cells(x, 9), .Cells(x, 15)).Resize(1,
7).Value
WeekNum 17, 1, 23, SheetValues, sh
End With

End Sub