Sub test()
Dim x As Integer
Dim r As Range
Dim r2 As Range
Dim r3 As Range
Set r = Range("I2")
Set r2 = Range("A14")
Do Until r2.Row = 78 Or r2.Offset(1, 0).Value > r
If IsError(r) Then
Exit Sub
ElseIf IsError(r2) Then
Exit Sub
ElseIf IsError(r3) Then
Exit Sub
End If
If r2.Value <= r.Value Then
Set r2 = r2.Offset(1, 0)
End If
If r2.Value > r Then
Set r2 = r2.Offset(-1, 0)
End If
Loop
r2.Offset(0, 1).Value = r
Set r = r.Offset(1, 0)
Set r2 = r2.Offset(0, 1)
Set r3 = r2.Offset(0, 1)
Do Until r.Row = 13
If IsError(r) Then
Exit Sub
ElseIf IsError(r2) Then
Exit Sub
ElseIf IsError(r3) Then
Exit Sub
End If
r2.Offset(r3.Value, 0).Value = r.Value
Set r = r.Offset(1, 0)
Set r2 = r2.Offset(r3.Value, 0)
Set r3 = r3.Offset(1, 0)
Loop
End Sub
Bookmarks