Discussion :

[Fildelyon]

Bonsoir à tous

Ce code me permet de séparer le contenu du Presse-papier (assemblé dans une autre application, et collé), puis de copier les champs dans plusieurs cellules sur la même (dernière) ligne non vide de ma feuille courante : il marche parfaitement bien et remplie sa fonction.

Mais il s'exécute en 6 secondes, alors que je m'attends à ce qu'il ne prenne que quelques dixièmes vu sa simplicité ....

Avez-vous une explication, une astuce pour accélérer la bestiole, voire un autre 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
Sub Extract()
 
' MàJ Nouvelle Commande
 
Application.ScreenUpdating = False
 
Dim CDE() As String
Dim C1 As String
Dim C9 As Variant
Dim C4, C6 As Date
Dim C7 As Double
 
Range("I1").Select
ActiveSheet.Paste
 
If I1 = "" Then
MsgBox ("Rien dans le Presse-Papier : Recommencez.")
GoTo Suite:
End If
 
 
CDE() = Split(Range("I1").Value, "=")
C1 = CDE(0) 'colonne 1 Dossier
C4 = CDE(1) ' colonne 4Date Cde
C6 = CDE(2) 'colonne 6 Date Facture
C7 = CDE(3) 'colonne 7 MontantTTC
C9 = CDE(4) 'colonne 8 TVA
 
Sheets("Commandes").Select
Range("A65536").End(xlUp).Offset(1, 0).Select
Selection.Value = C1
 
Range("A65536").End(xlUp).Offset(0, 6).Select
Selection.Value = C7
Selection.NumberFormat = "#,##0.00"
 
Range("A65536").End(xlUp).Offset(0, 8).Select
Selection.Value = C9 / 100
 
Range("A65536").End(xlUp).Offset(0, 3).Select
Selection.Value = C4
Selection.NumberFormat = "dd/mm/yy;@"
 
Range("A65536").End(xlUp).Offset(0, 5).Select
Selection.Value = C6
Selection.NumberFormat = "dd/mm/yy;@"
 
MsgBox "Commande ajoutée - Achats à renseigner."
 
Suite:
 
Range("I1").Clear
 
Range("A65536").End(xlUp).Offset(0, 0).Select
 
Application.ScreenUpdating = True
 
End Sub

En remplaçant

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Range("A65536").End(xlUp).Offset(0, 6).Select

par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ActiveCell.Offset(0, 6).Select

pour éviter de faire des A/R en bas du fichier, ça ne change pas grand chose ...

Merci pour votre aide.

[Invité]

Bonjour,

Supprimez les Select et neutralisez vos calculs si vous avez beaucoup de formules. A tester :

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
 
Sub Extract()
 
' MàJ Nouvelle Commande
 
Dim CDE() As String
Dim C1 As String
Dim C9 As Variant
Dim C4 As Date, C6 As Date
Dim C7 As Double
 
Dim LigneCommande As Long
Dim CelluleCommande As Range
Dim HeureDebut, HeureFin, TempsTotal
 
    HeureDebut = Timer    ' Définit l'heure de début.
 
    With Application
         .ScreenUpdating = False
         .Calculation = xlCalculationManual
    End With
 
    With Sheets("Feuil1") ' A adapter
 
         .Range("I1").Select
         .Paste
 
         If .Range("I1") = "" Then
            MsgBox "Rien dans le Presse-Papier : Recommencez !", vbCritical
            GoTo Suite
         End If
 
         CDE() = Split(.Range("I1").Value, "=")
         C1 = CDE(0) 'colonne 1 Dossier
         C4 = CDE(1) ' colonne 4Date Cde
         C6 = CDE(2) 'colonne 6 Date Facture
         C7 = CDE(3) 'colonne 7 MontantTTC
         C9 = CDE(4) 'colonne 8 TVA
 
   End With
 
   With Sheets("Commandes")
 
        LigneCommande = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        Set CelluleCommande = .Range(.Cells(LigneCommande, 1), .Cells(LigneCommande, 9))
 
        CelluleCommande(1) = C1
 
        With CelluleCommande(4)
           .Value = C4
           .NumberFormat = "dd/mm/yy;@"
        End With
 
        With CelluleCommande(6)
           .Value = C6
           .NumberFormat = "dd/mm/yy;@"
        End With
 
        With CelluleCommande(7)
           .Value = C7
           .NumberFormat = "#,##0.00"
        End With
 
        CelluleCommande(9) = C9 / 100
 
        .Activate
 
        MsgBox "Commande ajoutée - Achats à renseigner !", vbInformation
 
   End With
 
   GoTo Suite
 
Suite:
 
       Sheets("Feuil1").Range("I1").Clear
       Set CelluleCommande = Nothing
 
       With Application
           .ScreenUpdating = True
           .Calculation = xlCalculationAutomatic
       End With
 
       HeureFin = Timer    ' Définit l'heure de fin.
       TempsTotal = HeureFin - HeureDebut    ' Calcule la durée totale.
       MsgBox "Temps total " & Round(TempsTotal, 1) & " seconde(s)"
 
End Sub

[ARTURO83]

Bonjour,

Collez ceci après le "Paste"

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
    Set f = Sheets("Commandes")
    If Range("I1") <> "" Then
        CDE() = Split(Range("I1").Value, "=")
        C1 = CDE(0) 'colonne 1 Dossier
        C4 = CDE(1) ' colonne 4Date Cde
        C6 = CDE(2) 'colonne 6 Date Facture
        C7 = CDE(3) 'colonne 7 MontantTTC
        C9 = CDE(4) 'colonne 9 TVA
        DerLig = f.Range("A65536").End(xlUp).Row + 1
        f.Cells(DerLig, "A") = C1
        f.Cells(DerLig, "G") = Format(C7, "0.00")
        f.Cells(DerLig, "H") = C9 / 100
        f.Cells(DerLig, "D") = Format(C4, "dd/mm/yy;@")
        f.Cells(DerLig, "F") = Format(C6, "dd/mm/yy;@")
        MsgBox "Commande ajoutée - Achats à renseigner."
        Range("I1").Clear
    Else
        MsgBox "Rien dans le Presse-Papier : Recommencez."
    End If
    Set f = Nothing
End if

Cdlt

[Fildelyon]

Merci à vous deux pour vos simplifications qui en effet, marchent parfaitement et font gagner du temps.

Vos codes, et notamment le timer, m'ont surtout permis de mettre en évidence que c'est le re-calcul de la feuille et du classeur, assez lourd, après les "coller" qui prend du temps.

C'est donc à moi de bosser à présent !

Merci et bon WE