XL 2021 Une aide pour optimiser du code VBA

Public Sub List_Noms()
'======================================================================
' Procédure pour lister les noms et les Tableaux Structurés du classeur
'======================================================================
Const NomFeuille = "LSTNOMS"
Dim nomP As Name
   On Error Resume Next: Application.DisplayAlerts = False
   Sheets(NomFeuille).Delete: On Error GoTo 0: Application.DisplayAlerts = True  ' supprimer NomFeuille
   Worksheets.Add(after:=Sheets(Sheets.Count)).Name = NomFeuille                 ' recréer NomFeuille
   With Sheets(NomFeuille)
      .Tab.Color = RGB(204, 255, 255)                                            ' couleur de l'onglet
      .Range("a1:c1") = Split("Nom cellule/Emplacement/Adresse Cellule", "/")    ' les titres colonnes A à C
      .Range("e1:g1") = Split("Nom Feuille/Nom Tableau/Adresse Tableau", "/")    ' les titres colonnes E à G
   '       For Each nomP In ThisWorkbook.Names..... suite du code
   End With

Public Sub List_All_Userforms2()
    Dim tbl(), vbcomp, count, sh As Worksheet
    ReDim Preserve tbl(1 To 1)
    'compilation dans une variable tableau les noms des formulaires
    
    For Each vbcomp In ThisWorkbook.VBProject.VBComponents
        If vbcomp.Type = 3 Then
            count = count + 1
            ReDim Preserve tbl(1 To count): tbl(count) = vbcomp.Name ' Nom du formulaire
        End If
    Next vbcomp
    
    If UBound(tbl) > 1 Then 'alors il y a des formulaire
        
        'comme un sauvage on brule la feuille
        'car je me suis appercu ( ajouter/ suprimmer  et rebelote)  ajoutait du poids inutilement dans le classeur
        'donc guillotine la feuille
        Application.DisplayAlerts = False
        For Each sh In ThisWorkbook.Worksheets
            If sh.Name = "TabFormulaires" Then sh.Delete
        Next
        
        'on repart donc avec une feuille vierge
        Set Feuille = Worksheets.Add(After:=Sheets(Sheets.count))
        DoEvents
        Feuille.Name = "TabFormulaires"
        With Feuille
            'transfert sur feuille
            .Cells(1) = "Nom Formulaire"
            .Cells(2, 1).Resize(UBound(tbl), 1).Value = Application.Transpose(tbl)
            DoEvents
            
            'conversion en Listobject de la plage occupé par le resultat
            With .ListObjects.Add(xlSrcRange, .UsedRange, , xlYes)
                .Name = "Tbl_Formulaires"
                .TableStyle = "TableStyleMedium7"
                .ShowAutoFilterDropDown = False
            End With
            
            'un peu de design
            With .Cells(1)
                .VerticalAlignment = xlCenter
                .RowHeight = 35.4
                .WrapText = False
                .Font.Size = 14
                .Font.Bold = True
                .Font.Name = "Tw Cen MT"
                .Font.Color = vbBlack
            End With
            
            With .Cells(2, 1).Resize(UBound(tbl) - 1)
                .HorizontalAlignment = xlLeft
                .VerticalAlignment = xlCenter
                '.Font.Color = vbBlack
                .Font.Size = 11
                '.Font.Bold = False
                .Font.Name = "Tw Cen MT"
            End With
            
            .Columns(1).AutoFit
            
        End With
        
    End If
      
End Sub