Bonjour

Je n'y comprend rien. J'avais pourtant résolu mon problème de changement de mot dans ma macro et le problème est réaparu

je vous poste mon code, en espérant que vous soyez capable de résoudre mon problème Merci à l'avance.

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
 
Sub generer_fichier()
'
' Generer_pages Macro.
'
 
 
 
Const Accents As String = "àâäåçéèêëîïôöùûüÈÉÊËÀÁÂÃÄÅÙÚÛÜ- ,"
Const Normaux As String = "aaaaceeeeiioouuuEEEEAAAAAAUUUU___"
 
 
    Dim c As Range, DerLigne As Integer, i As Byte
    Dim Ancien As String, Nouveau As String, Cible As String
    Dim VBComp As VBComponent
    Dim b As Integer
    Dim wbk As Workbook
    Dim w As Integer
    Dim Module As Object
 
 
    Sheets("Menu").Select
    DerLigne = Range("A65536").End(xlUp).Row
    For Each c In Range("A2:A" & DerLigne)
        For w = 1 To Len(Accents)
            c.Value = Replace(c.Value, Mid(Accents, w, 1), Mid(Normaux, w, 1))
        Next w
    Next c
 
 
    Sheets("Menu").Select
    ' Déterminer combien d'agent sur la feuille Menu
    FinalAgent = Range("A65000").End(xlUp).Row
 
    ' Loop pour chaque agent
    For x = 2 To FinalAgent
 
        Sheets("Menu").Select
        ThisAgent = Range("A" & x).Value
 
'Copie des feuilles
 
        Application.ScreenUpdating = False
        ThisWorkbook.Sheets(Array("Janvier", "Admin_Janvier", "Fevrier", "Admin_Fevrier", "Mars", "Admin_Mars", "Avril", "Admin_Avril", "Mai", "Admin_Mai", "Juin", "Admin_Juin", "Juillet", "Admin_Juillet", "Aout", "Admin_Aout", "Septembre", "Admin_Septembre", "Octobre", "Admin_Octobre", "Novembre", "Admin_Novembre", "Decembre", "Admin_Decembre", "AGT", "SGT")).Copy        'adapte les noms des feuilles
 
 
'Céation du nouveau fichier et enregistrement
        Set wbk = ActiveWorkbook
 
 
    Ancien = "New_Agt"
    Nouveau = "ThisAgent"
 
       For Each VBComp In wbk.VBProject.VBComponents
        With VBComp.CodeModule
            If VBComp.CodeModule.Name <> "AfficheMacrosActiveworkbook" Then
                For b = 1 To VBComp.CodeModule.CountOfLines
                    Cible = VBComp.CodeModule.Lines(b, 1)
                    Cible = Replace(Cible, Ancien, Nouveau)
                    VBComp.CodeModule.ReplaceLine b, Cible
                Next b
            End If
        End With
    Next VBComp
 
 
 
 
 
        Application.DisplayAlerts = False
        wbk.SaveAs ThisWorkbook.Path & "\" & ThisAgent & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
 
 
 
 
 
 
Application.DisplayAlerts = True
 
 
 
wbk.Close
Set wbk = Nothing
 
 
    Next x
 
 
 
Application.ScreenUpdating = False
 
    Sheets("Menu").Select
    MsgBox ("Opération terminée.")
End Sub
Merci