Discussion :

[Invité]

Bonjour,

Depuis mon classeur courant, Je vérifie existence d'un fichier, s'il existe on l'ouvre sinon on le crée avec une seule feuille dont le nom sera la valeur de la cellule B3 de mon classeur. En B3, il y a une liste de toutes les feuilles à créer.

Je bloque pour faire la suite:
1- si le fichier existe, il est ouvert puis on vérifie l'existence de l'onglet dont le nom est celui de la cellule B3 de mon classeur de départ
2- si la feuille n'existe pas, elle est ajoutée et renommée (valeur de B3), on fait un copier/coller de la feuille "MaFeuille".
3- si la feuille existe, un message demande l'écrasement des données
a- si la réponse est oui, on vide la feuille et on refait un copier/coller
b- si la réponse est non, on ferme le fichier et on sort de la procédure.

En espérant avoir été clair, voici 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
Sub Créer_XL()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim NomDossier As String, NomSousDossier As String, Chemin As String, Fichier As String, NomFichier As String, NomOnglet As String
Dim F As Worksheet
 
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 
fd = ThisWorkbook.Name
NomOnglet = Replace(Sheets("mafeuille").Range("B3"), "/", "_")
NomDossier = Year(Sheets("MaFeuille").Range("B4"))
NomSousDossier = "RAPPORTS"
NomFichier = "PV " & StrConv(Format(Sheets("MaFeuille").Range("B4"), "mmm yyyy"), _
vbProperCase) & ".xlsx"
 
Chemin = ThisWorkbook.Path
 
ChDir Chemin 'se place sur le repertoire du programme
 
If Dir(Chemin & "\" & NomDossier, vbDirectory) = "" Then    'teste et crée le dossier
    MkDir Chemin & "\" & NomDossier
End If
 
ChDir Chemin & "\" & NomDossier   'se place dans le dossier
 
If Dir(Chemin & "\" & NomDossier & "\" & NomSousDossier, vbDirectory) = "" Then 'teste et crée sous-dossier
    MkDir Chemin & "\" & NomDossier & "\" & NomSousDossier
End If
 
repert = Chemin & "\" & NomDossier & "\" & NomSousDossier   'définit chemin sous-dossier
ChDir repert        'se place dans le sous-dossier
Fichier = repert & "\" & NomFichier
 
' ****************à partir d'ici code à corriger*************************
 
If Dir(Fichier) <> "" Then
Workbooks.Open (Fichier)
For Each F In ActiveWorkbook.Worksheets         'boucle sur les feuilles
    If F.Name = NomOnglet Then If MsgBox("La feuille existe déjà," & Chr(10) & "Voulez-vous l'écraser?", vbYesNo) = vbNo Then GoTo suite:
Next F
'End If
'Else
 
'End If
'====================================================
    Sheets.Add After:=Sheets(Sheets.Count)  'ajouter une feuille
    Sheets(Sheets.Count).Name = NomOnglet   'renommer la feuille
 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Application.SheetsInNewWorkbook = 1
    Workbooks.Add.Activate
    ActiveWorkbook.SaveAs NomFichier
    MsgBox NomFichier
    Sheets("Feuil1").Name = NomOnglet
 
'copie
 
    Windows(fd).Activate
    Sheets("MaFeuille").Select
    Sheets("MaFeuille").Cells.Select
    Application.CutCopyMode = False
    Selection.Copy
    'coller
    Windows(Workbooks(Workbooks.Count).Name).Activate
    Sheets(NomOnglet).Activate
    Sheets(NomOnglet).Range("A1").Select
    ActiveSheet.Paste
    Sheets(NomOnglet).Range("A1").Select
 
    MsgBox "Opération terminée!" & Chr(10) & Chr(10) & "Le Fichier a été enregistré dans le répertoire:" _
& Chr(10) & Chr(10) & repert, vbInformation
 
'=====================================================
End If
suite:
   On Error Resume Next
ActiveWorkbook.Save 'chemin & nomfichier
ActiveWorkbook.Close
 
Range("A1").Select
 
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

En vous remerciant par avance.

Cordialement,