Barryj
06-18-2007, 01:11 PM
I posted this workbook about a month ago and it works fine, but I need to pickup some extra data form it and place it on the destination sheet.
If week 1 is selected I need it to pickup the date from 1AA and place it in row 1 column 12 of destination sheet, if week 2 is selected then pickup the date from 1BC and place it in destination sheet row 1 column 12.
I tried to alter this myself without any luck, this is the code that is in the attachment.
Option Explicit
Sub Shows()
UserForm1.Show False
End Sub
Sub Test(ShNo As Long, Wk As Long, TSNo As Long)
Dim sh As Worksheet, Tsh As Worksheet
Dim i As Long, k As Long, Rw As Long, Oset As Long
Set sh = Sheets("Sheet" & ShNo)
On Error Resume Next
Set Tsh = Sheets("Time Sheet Week" & TSNo)
If Tsh Is Nothing Then
Sheets.Add after:=Sheets("Time Sheet Week" & TSNo - 1)
ActiveSheet.Name = "Time Sheet Week" & TSNo
Set Tsh = Sheets("Time Sheet Week" & TSNo)
End If
If Wk = 2 Then Oset = 28
For i = 4 To sh.Cells(Rows.Count, 1).End(xlUp).Row
With Tsh
.Cells(Rw + 1, 5) = sh.Cells(i, 2)
.Cells(Rw + 1, 8) = sh.Cells(i, 59)
For k = 0 To 6
.Cells(Rw + 2 + k, 2) = sh.Cells(i, 4 + Oset + (4 * k))
.Cells(Rw + 2 + k, 3) = sh.Cells(i, 5 + Oset + (4 * k))
.Cells(Rw + 2 + k, 7) = sh.Cells(i, 6 + Oset + (4 * k))
.Cells(Rw + 2 + k, 2).Interior.ColorIndex = 6
.Cells(Rw + 2 + k, 3).Interior.ColorIndex = 7
.Cells(Rw + 2 + k, 7).Interior.ColorIndex = 8
sh.Cells(i, 4 + (4 * k)).Interior.ColorIndex = 6
sh.Cells(i, 5 + (4 * k)).Interior.ColorIndex = 7
sh.Cells(i, 6 + (4 * k)).Interior.ColorIndex = 8
Next k
End With
Rw = Rw + 14
Next i
End Sub
Thanks for any assistance.
If week 1 is selected I need it to pickup the date from 1AA and place it in row 1 column 12 of destination sheet, if week 2 is selected then pickup the date from 1BC and place it in destination sheet row 1 column 12.
I tried to alter this myself without any luck, this is the code that is in the attachment.
Option Explicit
Sub Shows()
UserForm1.Show False
End Sub
Sub Test(ShNo As Long, Wk As Long, TSNo As Long)
Dim sh As Worksheet, Tsh As Worksheet
Dim i As Long, k As Long, Rw As Long, Oset As Long
Set sh = Sheets("Sheet" & ShNo)
On Error Resume Next
Set Tsh = Sheets("Time Sheet Week" & TSNo)
If Tsh Is Nothing Then
Sheets.Add after:=Sheets("Time Sheet Week" & TSNo - 1)
ActiveSheet.Name = "Time Sheet Week" & TSNo
Set Tsh = Sheets("Time Sheet Week" & TSNo)
End If
If Wk = 2 Then Oset = 28
For i = 4 To sh.Cells(Rows.Count, 1).End(xlUp).Row
With Tsh
.Cells(Rw + 1, 5) = sh.Cells(i, 2)
.Cells(Rw + 1, 8) = sh.Cells(i, 59)
For k = 0 To 6
.Cells(Rw + 2 + k, 2) = sh.Cells(i, 4 + Oset + (4 * k))
.Cells(Rw + 2 + k, 3) = sh.Cells(i, 5 + Oset + (4 * k))
.Cells(Rw + 2 + k, 7) = sh.Cells(i, 6 + Oset + (4 * k))
.Cells(Rw + 2 + k, 2).Interior.ColorIndex = 6
.Cells(Rw + 2 + k, 3).Interior.ColorIndex = 7
.Cells(Rw + 2 + k, 7).Interior.ColorIndex = 8
sh.Cells(i, 4 + (4 * k)).Interior.ColorIndex = 6
sh.Cells(i, 5 + (4 * k)).Interior.ColorIndex = 7
sh.Cells(i, 6 + (4 * k)).Interior.ColorIndex = 8
Next k
End With
Rw = Rw + 14
Next i
End Sub
Thanks for any assistance.