Optimisation macro pour gagner du temps

**Mél3790** · 07/02/2017, 10h05

Bonjour,

Savez-vous comment je pourrais optimiser la macro ci-dessous ?
C'est un Userform qui charge des lignes dans une listbox.
Quand on clique sur un item de la listbox, puis sur le bouton "générer", ça génère un nouveau classeur, la feuille se remplit d'après un modèle.
Le classeur va s'enregistrer automatiquement dans un dossier.

Le temps que le nouveau classeur se génère, cela peut prendre 1 minute. A savoir que chaque semaine, on doit générer une quarantaine de classeur.
Il faudrait que ça soit instantané ....

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
Private Sub Boutongénérer_click()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
 
 
 
Dim I, numlign
 
 
For I = 0 To ListBox1.ListCount - 1
    If ListBox1.Selected(I) = True Then
        numlign = ListBox1.List(I, 9)
    End If
Next I
 
Columns("aj:aj").Select
    numlign = selection.Find(What:=numlign, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).EntireRow.Select
 
        ActiveCell.Offset(0, 26).Value = TextBox6
        ActiveCell.Offset(0, 27).Value = TextBox1
        ActiveCell.Offset(0, 28).Value = TextBox2
        ActiveCell.Offset(0, 29).Value = TextBox3
        ActiveCell.Offset(0, 30).Value = TextBox4
        ActiveCell.Offset(0, 31).Value = TextBox5
        ActiveCell.Offset(0, 1).Value = cb
        ActiveCell.Offset(0, 5).Value = cbformation
        ActiveCell.Offset(0, 14).Value = cborganisme
        ActiveCell.Offset(0, 15).Value = cblieu
        ActiveCell.Offset(0, 9).Value = cbsemaine
        ActiveCell.Offset(0, 32).Value = T13
        ActiveCell.Offset(0, 33).Value = T14
        ActiveCell.Offset(0, 13).Value = T7
 
 
        Worksheets("Modèle").Copy After:=Worksheets(ThisWorkbook.Sheets.Count)
        ActiveCell.Select
        ActiveSheet.Name = cb.Value
 
        With Worksheets(ThisWorkbook.Sheets.Count) 'avec l'onglet créé
 
            'on remplit notre modèle comme on veut...
            .range("AD2") = cb.Value
            .range("A4") = cbformation.Value
            .range("P8") = cborganisme.Value & " à " & cblieu.Value
            .range("AH8") = TextBox1.Value
            .range("AK8") = TextBox2.Value
            .range("AN8") = TextBox3.Value
            .range("AQ8") = TextBox4.Value
            .range("AT8") = TextBox5.Value
            .range("AY2") = cbsemaine.Value
            .range("AU3") = T13.Value
            .range("BA3") = T14.Value
            .range("P10") = "Formation" & " " & T7.Value
            .range("A57") = TextBox6.Value
 
 
        End With
        ActiveSheet.Move 'Déplace la feuille générée à partir du modèle vers un nouveau classeur
 
 
    ChDir "C:\3-EMPLOI\Form\Form 2017"
    ActiveWorkbook.SaveAs Filename:="C:\3-EMPLOI\Form\Form 2017\" & cb.Value & " - Semaine " & cbsemaine.Value & " - (" & cbformation.Value & ")" & ".xlsm", FileFormat:= _
        xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
 
 
 
 
 
     Windows("SUIVI EMPLOI.xlsm").Activate
    Sheets("Suivi").Select
 
 
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
 
End Sub

merci !

**unparia** · 07/02/2017, 10h28

Bonjour
Déjà : je ne comprends pas pourquoi ces lignes

Code :

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

1
2
3
4
5
For I = 0 To ListBox1.ListCount - 1
    If ListBox1.Selected(I) = True Then
        numlign = ListBox1.List(I, 9)
    End If
Next I

qui sont telles que, si la listbox est en multiselect, numlign sera ce qu'il y a en colonne 9 de l'article de plus grand index qui s'y trouve sélectionné.
Quelle est la raison de cette boucle ?

D'ailleurs : peux-tu nous dire avec précision quels sont les tenants et aboutissants ?

**Mél3790** · 07/02/2017, 10h58

La listbox n'est pas en multiselect.
Dans mon tableau, en fin de ligne, j'ai des numéros uniques qui s'inscrive lorsqu'on y ajoute des données.
Ainsi je récupère les numéros uniques pour alimenter la listbox grâce à une Function.
De ce fait, quand je clique sur un item de la listbox, il récupère le numéro de ligne pour la sélectionner dans le tableau.
Ca fonctionne très bien.

Je souhaite "simplement" améliorer le temps de réponse de la macro.