I think I have the second part, 1st part , need to give example to hav
clear picture

Sub CreateMirrorSchedule()

Dim wsCopy As Worksheet
Dim wsPaste As Worksheet
Dim rgCopy As Range
Dim rgPaste As Range

Application.ScreenUpdating = False

Set wsCopy = ThisWorkbook.Worksheets("Weekly Schedule")
Set wsPaste = ThisWorkbook.Worksheets("Schedule Mirror")
For i = 1 To 14
MsgBox i
Set rgCopy = wsCopy.Range("b9").Offset(0, i)
Set rgPaste = wsPaste.Range("b9").Offset(0, i)

wsCopy.Select

Do Until rgCopy = wsCopy.Range("b69").Offset(i, 0)
wsCopy.Select
If IsEmpty(rgCopy) Then
Set rgCopy = rgCopy.Offset(2, 0)
Set rgPaste = rgPaste.Offset(2, 0)
Else
rgCopy.Select
rgCopy.Copy
wsPaste.Select
rgPaste.PasteSpecial xlPasteValues
Select Case rgPaste.Value
Case Is < 1
Set rgCopy = rgCopy.Offset(2, 0)
Set rgPaste = rgPaste.Offset(2, 0)
Case 1
rgPaste.FormulaR1C1 = "1:00"
Case 1.25
rgPaste.FormulaR1C1 = "1:15"
Case 1.5
rgPaste.FormulaR1C1 = "1:30"
Case 1.75
rgPaste.FormulaR1C1 = "1:45"
Case 2
rgPaste.FormulaR1C1 = "2:00"
Case Else
Set rgCopy = rgCopy.Offset(2, 0)
Set rgPaste = rgPaste.Offset(2, 0)
End Select
Set rgCopy = rgCopy.Offset(2, 0)
Set rgPaste = rgPaste.Offset(2, 0)
End If
Loop
Next
'####### The above pattern is repeated 14 times
########

Set wsCopy = Nothing
Set wsPaste = Nothing
Set rgCopy = Nothing
Set rgPaste = Nothing

Application.CutCopyMode = False
Application.ScreenUpdating = True
End Su

--
anilsolipura
-----------------------------------------------------------------------
anilsolipuram's Profile: http://www.excelforum.com/member.php...fo&userid=1627
View this thread: http://www.excelforum.com/showthread.php?threadid=38205