Code VBA lent voire très lent

Bonjour à tous,

Voilà je viens à vous car je rencontre un problème de lenteur sur un classeur excel et voilà l'objet du délit. Ce code permet d'incrémenter des données dans un tableau en rajoutant une ligne à chaque click sur un bouton valider. Pour les premières lignes tout se passe bien mais au bout de plusieurs centaines rien ne va plus. Il faut attendre une 30aine de secondes pour que le code fasse son œuvre. Une idée de votre coté?

Merci par avance.

Private Sub VALIDER_Click()
Dim ctrl As Control
Dim r As Integer
Dim derligne As Long
With Worksheets("CELLULE QUALITE")
If .Range("C11") = "" Then derligne = 11 Else derligne = .Range("C" & Rows.Count).End(xlUp).Row + 1
For Each ctrl In UserForm1.Controls
r = Val(ctrl.Tag)
Cells(derligne, 6) = Date
If r > 0 Then
If r = 6 Or r = 8 Then
.Cells(derligne, r) = CDate(ctrl)
If r = 7 Then .Cells(derligne, r).NumberFormat = "h:mm;@"
Else
.Cells(derligne, r) = ctrl
End If
End If
Next
Sheet1.Cells(derligne, 3) = Val(TextBox6)
End With
End
End Sub

Bonjour,

Je me lance sans fichier

Option Explicit
Private Sub VALIDER_Click()
      Dim Ws As Worksheet
      Dim ctrl As Control
      Dim r As Integer
      Dim derligne As Long
10        Application.ScreenUpdating = False
20        Set Ws = Worksheets("CELLULE QUALITE")
30        With Ws
40            If .Range("C11") = "" Then
50                derligne = 11
60            Else
70                derligne = .Range("C" & Rows.Count).End(xlUp).Row + 1
80            End If
90            For Each ctrl In UserForm1.Controls
100               r = Val(ctrl.Tag)
110               .Cells(derligne, 6) = Date
120               Select Case r
                      Case 6, 8
130                       .Cells(derligne, r) = CDate(ctrl)
140                   Case 7
150                       .Cells(derligne, r).NumberFormat = "h:mm;@"
160                   Case Else
170                       .Cells(derligne, r) = ctrl
180               End Select
190           Next
200           Sheet1.Cells(derligne, 3) = Val(TextBox6)
210       End With
220       Set Ws = Nothing
End Sub

Bonjour,

Je teste tout ça ce soir et je vous dit. Merci pour la réponse rapide en tout cas.

Cordialement