Microsoft 365 Dupliquer un onglet en le renommant automatiquement

Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fin: If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, [D5:D1000]) Is Nothing Then
         Application.ScreenUpdating = False
         If LCase(Target) = "oui" And Cells(Target.Row, "A") <> "" Then
            FeuilleSource = ActiveSheet.Name
            Nom = Cells(Target.Row, "A")
            ActiveSheet.Copy After:=Worksheets(Sheets.Count)
            ActiveSheet.Name = Nom
            Sheets(FeuilleSource).Select
         End If
    End If
Fin:
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Fin2
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, [A5:D1000]) Is Nothing Then
        L = Target.Row: Nom = Cells(L, "A")
        If Nom <> "" And LCase(Cells(L, "D")) = "oui" Then Sheets(Nom).Select
    End If
Fin2:
End Sub