Bonjour

J'aimerais connaitre la façon de faire pour empêcher que le classeur écrase un classeur déjà existant. Et si possible de passer à la création du classeur suivant.

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 generer_fichier()
'
' Generer_pages Macro.
'
Application.ScreenUpdating = False '=> A placer en début de 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
 
    ' Déterminer combien d'agent sur la feuille Menu
    FinalAgent = Range("A65000").End(xlUp).Row
    ' Loop pour chaque agent
    For x = 2 To FinalAgent
        ThisAgent = Range("A" & x).Value
'Copie des feuilles
        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 = True      'En placant True à la place de False, il me demande si je veux écraser l'ancien classeur. Est ce possible tout simplement de passer au suivant sans que je reçoive se message?
 
 
wbk.SaveAs ThisWorkbook.Path & "\" & ThisAgent & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
Application.DisplayAlerts = True
wbk.Close
Set wbk = Nothing
     Next x
Application.ScreenUpdating = True '=> A placer à la fin et il faut mettre "True"
MsgBox ("Opération terminée.")
End Sub

Merci de votre aide encore une fois