XL 2016 VBA insérer automatiquement une valeur sous la cellule active

Sub Worksheet_Change(ByVal Target As Range)
Dim FinNom As Long
Dim x, y As Long
FinNom = ActiveSheet.Range("A7").End(xlDown).Row
  x = Cells(9, ActiveCell.Column).Value
  y = Cells(FinNom + 4, ActiveCell.Column).Value

If Not Application.Intersect(Target, Range("Y8:CB100")) Is Nothing Then 'met en majuscule la saisie
    Application.EnableEvents = False
    Target = UCase(Target)
    Application.EnableEvents = True
End If

If Target.Column < 25 Then Exit Sub 'si avant colonne 25 on sort de la procédure

If Target.Row < FinNom Then ' si saisie avant la ligne située avant finnom
    Select Case Target.Value
    'Case ""
     '   ActiveCell.Offset(0, 0) = ""
    Case "P"
        ActiveCell.Offset(0, 0) = x 'Cells(9, 0).Value
    Case "X"
        ActiveCell.Offset(0, 0) = x 'Cells(9, 0).Value
    Case "A"
        ActiveCell.Offset(0, 0) = ""
    End Select
Else
If Target.Row > FinNom Then ' si saisie avant la ligne située après finnom
    Select Case Target.Value
    'Case ""
     '   ActiveCell.Offset(1, 0) = ""
    Case "P"
        ActiveCell.Offset(0, 0) = y 'Cells(FinNom + 3, 0).Value
    Case "X"
        ActiveCell.Offset(0, 0) = y 'Cells(FinNom + 3, 0).Value
    Case "A"
        ActiveCell.Offset(0, 0) = ""
    End Select
End If
End If
End Sub

Private CdD As Range

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set CdD = ActiveCell
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
MsgBox CdD.Address
End Sub

Private Sub Worksheet_Activate()
Range("A1").Select
End Sub

Private Sub Workbook_Open()
Sheets("Feuil1").Activate 'à adapter avec l'onglet en question
End Sub