Accélération de procédure

Bonjour,

J'utilise le code ci-dessous et celui-ci met plus de 10 secondes à s'éxécuter... J'ai essayer de placer screenUpdating mais rien n'a changé... (Peut-être que je l'ai mal fait)...

Auriez-vous une meilleure idée, car il me semble qu'en 2 secondes maximum cette procédure doit s'éxécuter normalement...

Merci de votre aide

 Public Sub commandbutton1_click()

ScreenUpdating = False

'Incremente automatiquement la ligne suivante
      Dim Wks As Worksheet
      Dim Ligne As Long
            
            Set Wks = Sheets(NomUtilisateur) '
            Ligne = Sheets(NomUtilisateur).[A65000].End(xlUp).Offset(1, 0).Row
              With Sheets(NomUtilisateur)
                .Cells(Ligne, 1) = NomUtilisateur '
                '.Cells(Ligne, 2) =  '
                .Cells(Ligne, 3) = Me.Label6 'MAJ
                .Cells(Ligne, 4) = Me.ComboBox1 'Client
                .Cells(Ligne, 5) = Me.ComboBox2 '
                .Cells(Ligne, 6) = Me.ComboBox3 'Civilité
                .Cells(Ligne, 7) = Me.TextBox1 'Prénom
                .Cells(Ligne, 8) = Me.TextBox2 'Nom
                .Cells(Ligne, 9) = Me.TextBox3 'Fonction
                .Cells(Ligne, 10) = Me.ComboBox4 '
                .Cells(Ligne, 11) = Me.ComboBox5 'DPT

              End With
 
    Creer.Hide
    Contact.Show
 
 ScreenUpdating = True
 End Sub

Ci-dessous le code de la MAJ :

Private Sub Worksheet_Change(ByVal sel As Range)
 ScreenUpdating = False
    Application.EnableEvents = False
    Cells(sel.Row, "C").Value = Date
    Application.EnableEvents = True
  ScreenUpdating = True
End Sub