Sub tt()
    Dim c As Range, t$, x1_, x2_
    For Each c In Cells(2, 9).Resize(Cells(Rows.Count, 9).End(3).Row - 1)
        If c > Now Then
            t = Replace(c.Offset(, -8), """", """""")
            b = Replace(c.Offset(, 1), """", "")
            b = Replace(b, "!", "")
            x1_ = Len("'Задача """ & TimeValue(c) & """,""" & b & """,""" & """,""" & t & "'")
            x2_ = Left(c.Offset(, -3), 255 - x1_ - 7)
            uu = "'Задача """ & TimeValue(c) & """,""" & b & """,""" & x2_ & """,""" & t & """,""" & c.Address(0, 0) & "'"
            Application.OnTime c, uu
        End If
    Next
    MsgBox "Задачи поставлены!"
End Sub

Sub Задача(s1 As Date, s2$, s3$, s4$, s5$)
    MsgBox "[" & "]" & s1 & " Напоминание: " & s2 & " в " & s4 & s3
    Application.Goto reference:=Range(s5).Offset(, -8), scroll:=True
End Sub