try this

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")
Set rgCopy = wsCopy.Range("C9")
Set rgPaste = wsPaste.Range("C9")

wsCopy.Select

Do Until rgCopy.address="$C$69"
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


'####### 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 Sub


--
anilsolipuram
------------------------------------------------------------------------
anilsolipuram's Profile: http://www.excelforum.com/member.php...o&userid=16271
View this thread: http://www.excelforum.com/showthread...hreadid=382056