Adresse de la cellule active?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cel As Range

Application.EnableEvents = False
If Not Intersect(Target, Range("a15:p200")) Is Nothing Then
  For Each Cel In Target.Cells
    If Not Intersect(Cel, Range("a15:p200")) Is Nothing Then
      'colonne Q : n° de ligne
      Cells(Cel.Row, "Q").Formula = Cel.Row
      'colonne R, formule : =AUJOURDHUI()
      Cells(Cel.Row, "R").FormulaLocal = "=AUJOURDHUI()"
      'colonne S, formule : = R(no de ligne)-Q(no de ligne)
      Cells(Cel.Row, "S").FormulaLocal = "=R" & Cel.Row & " - Q" & Cel.Row
    End If
  Next Cel
End If
Application.EnableEvents = True

End Sub

Private Sub Worksheet_Activate()
'Effacer les lignes surlignées après 5 jours
'
Const p As Integer = 5  'période = 5 jour
Dim Cel As Range

Application.EnableEvents = False
For Each Cel In Range("Q15:Q200").Cells
  If Now - Cells(Cel.Row, "Q").Value >= p Then
    'Effacer la couleur
    Range(Cells(Cel.Row, "A"), Cells(Cel.Row, "P")).Interior.ColorIndex = xlColorIndexNone
  End If
Next Cel
Application.EnableEvents = True

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
'Surligner les lignes modifiées
Dim Cel As Range

Application.EnableEvents = False
If Not Intersect(Target, Range("a15:p200")) Is Nothing Then
  For Each Cel In Target.Cells
    If Not Intersect(Cel, Range("a15:p200")) Is Nothing Then
      'colonne Q : instant de la modification
      Cells(Cel.Row, "Q").Formula = Now
      'ligne surlignée e vert
      Range(Cells(Cel.Row, "A"), Cells(Cel.Row, "P")).Interior.ColorIndex = 6
    End If
  Next Cel
End If
Columns("Q").AutoFit
Application.EnableEvents = True

End Sub