Bien le bonjour au forum,

Je viens vers vous à la suite d'une erreur récurrente mais dont je n'arrive pas à comprendre la logique :

1) J'utilise ma macro pour créer un dossier sur mon bureau contenant un fichier excel et un doc PDF,
2) Puis copier coller des infos provenant de mon fichier Excel de départ dans le nouveau fichier excel fraîchement créé.

Ci dessous mon code :
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
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
Sub Save_PDF()
Dim XLBook As Workbook
 
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
 
On Error GoTo Err1
A = Sheets(Feuil3.Name).Range("B1").Value
MkDir (Environ("userprofile") & "\Desktop\Audit Follow-up")
 
 
On Error Resume Next
'On sélectionne les feuilles qui nous intéressent à enregistrer en PDF"
ActiveWorkbook.Sheets(Array(Feuil1.Name, Feuil11.Name, Feuil12.Name, Feuil2.Name, Feuil3.Name, Feuil10.Name)).Select
 
'On choisit d'enregistrer sur le bureau quel que soit l'ordinateur utilisé
ChDir Environ("userprofile") & "\Desktop\Audit Follow-up"
 
'On active les feuilles afin de prendre en compte leurs contenus, puis on renomme le fichier final
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:="Audit Follow-up", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
 
Feuil8.Select
Application.DisplayAlerts = False
'On crée sur le bureau un nouveau fichier Excel
Workbooks.Add.SaveAs "Suivi Audits Externes.xlsx"
'On ouvre le nouveau fichier Excel créé
Workbooks.Open ("Suivi Audits Externes.xlsx")
Sheets.Add.Name = "Revue Analytique mensuelle"
Sheets.Add.Name = "Détails Audits externes"
Sheets.Add.Name = "Suivi Audits externes"
 
 
Dim Compteur As Integer, Nom As String
    Application.DisplayAlerts = False
    For Compteur = Worksheets.Count To 1 Step -1
        Nom = Sheets(Compteur).Name
        Select Case Nom
        Case "Suivi Audits externes", "Détails Audits externes", "Revue Analytique mensuelle"
 
        Case Else
            Sheets(Compteur).Delete
        End Select
    Next Compteur
    Application.DisplayAlerts = True
 
'On copie colle les informations dans ce nouveau fichier Excel
'Suivi des audits externes
ThisWorkbook.Sheets(Feuil2.Name).Activate
            Cells.Copy
Workbooks("Suivi Audits Externes.xlsx").Activate
            ActiveWorkbook.Sheets("Suivi Audits externes").Activate
            Cells.Select
            With Selection
            .PasteSpecial xlPasteAll
            End With
            Application.CutCopyMode = False
            Cells.Copy
            Cells.PasteSpecial xlValues
            Range("A1").Select
'Détails des audits externes
ThisWorkbook.Sheets(Feuil3.Name).Activate
            Cells.Copy
Workbooks("Suivi Audits Externes.xlsx").Activate
            ActiveWorkbook.Sheets("Détails Audits externes").Activate
            Range("A1").Select
            With Selection
            .PasteSpecial xlPasteAll
            End With
            Application.CutCopyMode = False
            Range("A1").Select
 
'Revue analytique mensuelle
ThisWorkbook.Sheets(Feuil10.Name).Activate
            Cells.Copy
Workbooks("Suivi Audits Externes.xlsx").Activate
            ActiveWorkbook.Sheets("Revue Analytique mensuelle").Activate
            Range("A1").Select
            With Selection
            .PasteSpecial xlPasteAll
            End With
            Application.CutCopyMode = False
            Range("A1").Select
 
ActiveWorkbook.Sheets("Suivi Audits externes").Activate
 
'Dim i As Long
'Dim Lien As Variant
 
    'Lien = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLinks)
    'For i = LBound(Lien) To UBound(Lien)
        'ActiveWorkbook.BreakLink Name:=Lien(i), Type:=xlLinkTypeExcelLinks
    'Next i
 
With ActiveWorkbook
    .Save
    .Close
End With
 
Application.DisplayAlerts = True
On Error GoTo 0
ThisWorkbook.Sheets(Feuil1.Name).Activate
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Exit Sub
Err1:
MsgBox "Un dossier portant ce nom existe déjà, veuillez le supprimer, puis relancer la macro"
On Error GoTo 0
End Sub

Juste avant d'entamer les copier/coller je peux supprimer/renommer mon dossier sans problème, c'est uniquement après avoir copier/coller que cela ne fonctionne plus.

J'ai pensé que cela provenait des formules qui conservaient les liens avec le dossier original mais même avec après avoir essayé de rompre les liens entre les deux classeurs, ca ne fonctionne toujours pas.

Après avoir essayé différent scénario le seul qui me permet de rename/delete c'est de fermer Excel et TOUS les classeurs actifs, ce qui est pas tellement pratique.

J'ai pas mal parcouru internet mais pas véritablement trouvé de solution pour ça, c'est donc vers vous que je me tourne maintenant

Si vous aviez des pistes ou des idées je suis preneur.

Un grand merci d'avance,