Bonjour à tous

Je cherche a simplifier un code d'une proceduer sur un bouton ok d'une userform car j'ai un temps d'attente entre chaque saisie ce qui n'est pas l'ideal pour de la saisie.

J'ai essyé de supprimer au maximum les select, mais apres je bloc.

Voici mon code:

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
 
Private Sub Ok_Click()
Application.ScreenUpdating = False
If longueur.Text = "" Then
MsgBox ("Vous n'avez rien saisi !")
Else
'transfert des données vers les cellules
With ActiveCell
.Value = Reference.Text
.Offset(0, 1).Value = designation.Text
.Offset(0, 2).Value = nombre.Text
End With
    Dim Longu As Currency, Larg As Currency
Longu = Val(longueur.Text)
Larg = Val(largeur.Text)
    If Longu > Larg Then
        ActiveCell.Offset(0, 4).Value = longueur.Text
        If Chb_surcote = True And Dim_surcote_Long.Text <> 0 Then
        Call Surcote(ActiveCell.Offset(0, 22))
        ActiveCell.Offset(0, 28).Value = Dim_surcote_Long.Text
 End If
 
        ActiveCell.Offset(0, 5).Value = largeur.Text
        If Chb_surcote = True And Dim_Surcote_larg.Text <> 0 Then
        Call Surcote(ActiveCell.Offset(0, 23))
        ActiveCell.Offset(0, 29).Value = Dim_Surcote_larg.Text
 End If
 
    Else
        ActiveCell.Offset(0, 4).Value = largeur.Text
        If Chb_surcote = True And Dim_surcote_Long.Text <> 0 Then
        Call Surcote(ActiveCell.Offset(0, 22))
        ActiveCell.Offset(0, 28).Value = Dim_surcote_Long.Text
 End If
 
        ActiveCell.Offset(0, 5).Value = longueur.Text
        If Chb_surcote = True And Dim_Surcote_larg.Text <> 0 Then
        Call Surcote(ActiveCell.Offset(0, 23))
        ActiveCell.Offset(0, 29).Value = Dim_Surcote_larg.Text
 End If
 
    End If
ActiveCell.Offset(0, 8).Value = SensFil.Text
 
ActiveCell.Offset(1, 0).Select
'remet tous les textbox a zero de la user form
Dim Ctrl As Control
 
For Each Ctrl In Me.Controls
    If TypeOf Ctrl Is MSForms.TextBox Then Ctrl.Value = ""
Next
'--------------------------------------------
'ajout automatique d'une ligne au tableau
Dim r As Integer, s As Integer, q As Integer, p As Integer
q = ActiveCell.Row ' N°de ligne en dessous de la derniere ligne saisi
Set firstCell = Range("F5") ' colonne avec formule mais pas de donnée
Set lastCell = Range("F65536").End(xlUp)
p = Range(lastCell, lastCell).Row ' Dernier N° de ligne du tableau
If p = q + 1 Then
    Range(lastCell, lastCell).Select
        r = ActiveCell.Row
        ActiveCell.Offset(1, 0).EntireRow.Select
        s = ActiveCell.Row
        Selection.Insert Shift:=xlDown
        Rows(r).Select
        Rows(r).Copy Rows(s)
End If
'reselection de la cellule d'entrée de donnée
Set firstCell = Range("D5")
Set lastCell = Range("D65536").End(xlUp)
Range(lastCell, lastCell).Offset(1, -1).Select
End If
Reference.SetFocus 'reactive la combobox reference
Application.Calculate
Application.ScreenUpdating = True
Set lastCell = Range("D65536").End(xlUp)
lastCell.Select
ActiveCell.Offset(1, -1).Select
Dim Ligne As Integer, Colonne As Integer
Ligne = lastCell.Row - 29
If Ligne >= 0 Then
With ActiveWindow
.ScrollRow = Ligne + 1
End With
End If
End Sub
 
Private Sub UserForm_Activate()
If ActiveSheet.Index < 4 Or (ActiveSheet.Index Mod 2) = 0 Or Worksheets.Count = ActiveSheet.Index Then
    MsgBox "Attention mauvaise selection, aucune saisie ne peut se faire sur cette feuille!"
    Zone2.Hide
    Exit Sub
End If
Num = ActiveSheet.Index
NomFeuille.ListIndex = ((Num - 1) / 2) - 2
Reference.ListIndex = ind
Reference.SetFocus
Set lastCell = Range("D65536").End(xlUp)
lastCell.Select
ActiveCell.Offset(1, -1).Select
Dim Ligne As Integer, Colonne As Integer
Ligne = lastCell.Row - 29
If Ligne >= 0 Then
With ActiveWindow
.ScrollRow = Ligne + 1
End With
End If
End Sub
Si quelqu'un peut me donner un coup de main, merci d'avance