Copier automatiquement nom d'un nouvel onglet

Sub listerfeuille()
For Each ws In Worksheets
    Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = ws.Name
Next ws
End Sub

Private Sub Workbook_NewSheet(ByVal Sh As Object)
Dim i As Long, x As Long
x = 0
For i = 2 To Sheets.Count
x = x + 1
Sheets(i).Name = x
Next i
End Sub

Private Sub Workbook_NewSheet(ByVal Sh As Object)
    With Feuil1
        .Range("a2") = .Range("a2") + 1
        Sh.Name = .Range("a2")
    End With
End Sub

Private Sub Workbook_NewSheet(ByVal Sh As Object)
    With Sheets("Modèle")
        .Range("a2") = .Range("a2") + 1
        Sh.Name = .Range("a2")
    End With
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim NouveauNum As Integer
Dim ws As Worksheet
Dim wsexist As Boolean

Application.ScreenUpdating = False
If Not Intersect(Target, Range("G9")) Is Nothing Then
    NouveauNum = Range("F9")
    wsexist = False
    If Range("F9").Value <> "" Then
        For Each ws In Worksheets
            If ws.Name Like NouveauNum Then
                wsexist = True
                Exit For
            End If
        Next ws
       
        If Not wsexist Then
            Worksheets("Modèle").Copy After:=Sheets("Modèle")
            ActiveSheet.Name = NouveauNum
            ActiveSheet.Range("a2") = NouveauNum
        End If
    End If
    Cancel = True
End If

Application.ScreenUpdating = True

End Sub