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 !