Bonjour à tous,

J'ai un petit soucis avec une macro que j'ai créer, en effet son exécution est très longue et je suis obligé de la lancer plusieurs fois pour que tout soit pris en compte...

Auriez vous une astuce pour que ce code fonctionne plus facilement ?

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
Public Maitre As Workbook
Public o As Worksheet
Public tbx As Workbook
Public nom_tbx As String
Public nom_fichier As Variant
 
 
 
 
Sub Supression_FO_saisie_terrain()
'
Tableaudesaisie = Application.GetOpenFilename(, , "Browse for workbook")
 
If Tableaudesaisie <> False Then
    Workbooks.Open Filename:=Tableaudesaisie
End If
 
nom_fichier = ActiveWorkbook.Name
 
 Set Maitre = Workbooks("Fichier Macro Maitre.xlsm")
 Set o = Maitre.Sheets("OUTILS")
 o.Activate
 
 Range("A10") = Tableaudesaisie
 
 Set tbx = Workbooks(nom_fichier)
 Set st = tbx.Sheets("Saisies terrain")
 st.Activate
 
 
'
'Initialisation
i = 9
 
 
'Boucle
While Range("S" & i) <> ""
If Range("A" & i) <> "" Then
Range("A" & i) = Range("A" & i)
Else
Range("A" & i) = Range("A" & i)
End If
 
Set MaPlage = Range("A" & i & ":AN" & i)
 
'Supression FO
On Error Resume Next
 
If Range("V" & i) = "standard" Then
Range("R" & i).Font.Bold = False
ElseIf Range("V" & i) = "haute" Then
MaPlage.Delete Shift:=xlUp
End If
 
 
'Surpression Forfait Optique
On Error Resume Next
 
If Range("A" & i) <> "" Then
Range("AA" & i) = "Non"
Else: Range("AA" & i) = Range("AA" & i)
End If
 
 
 
'Boucle
i = i + 1
Wend
 
'Supression matériel projeté
Range("AI9:AI5000").ClearContents
Range("AJ9:AJ5000").ClearContents
Range("AM9:AM5000").ClearContents
Range("AN9:AN5000").ClearContents
 
 
 
End Sub
Merci par avance pour vos astuces.