cathodique
XLDnaute Barbatruc
Bonjour,
Depuis MonClasseur, je crée un autre pour y sauvegarder des données dans différentes feuilles. Je crée donc un répertoire et un sous-répertoire où sera enregistré ce nouveau classeur, tout en vérifiant son l'existence. S'il n'existe pas il est créé avec une feuille qui portera comme nom le contenu de la cellule B3 (en remplaçant "/" par "_"), jusque là ça va.
Je voudrais maintenant vérifier si ce nouveau classeur contient une feuille dont le nom est le contenu de la cellule B3 de MonClasseur (cette cellule contient une liste correspondant aux noms des feuilles à créer dans le nouveau classeur).
Si la feuille existe, un message demande si on écrase les données, si la réponse est oui alors on vide la feuille puis on fait un copier_coller, si non on sort de la procédure. Par contre, si la feuille n'existe pas on en rajoute une nouvelle, on la renomme (B3) et on fait un copier_coller.
C'est pour cette dernière partie que je m'embrouille. Je vous remercie vouloir m'aider à finaliser le code ci-dessous
Depuis MonClasseur, je crée un autre pour y sauvegarder des données dans différentes feuilles. Je crée donc un répertoire et un sous-répertoire où sera enregistré ce nouveau classeur, tout en vérifiant son l'existence. S'il n'existe pas il est créé avec une feuille qui portera comme nom le contenu de la cellule B3 (en remplaçant "/" par "_"), jusque là ça va.
Je voudrais maintenant vérifier si ce nouveau classeur contient une feuille dont le nom est le contenu de la cellule B3 de MonClasseur (cette cellule contient une liste correspondant aux noms des feuilles à créer dans le nouveau classeur).
Si la feuille existe, un message demande si on écrase les données, si la réponse est oui alors on vide la feuille puis on fait un copier_coller, si non on sort de la procédure. Par contre, si la feuille n'existe pas on en rajoute une nouvelle, on la renomme (B3) et on fait un copier_coller.
C'est pour cette dernière partie que je m'embrouille. Je vous remercie vouloir m'aider à finaliser le code ci-dessous
Code:
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:
End If
Next F
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) & "Le Fichier a été enregistré dans le répertoire:" _
& Chr(10) & repert, vbInformation
suite:
On Error Resume Next
ActiveWorkbook.Save 'chemin & nomfichier
ActiveWorkbook.Close
Range("A1").Select
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub