Ajouter feuille suivant conditions

[cathodique]

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

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

 

[Paritec]

Re : Ajouter feuille suivant conditions

Bonjour Cathodique le forum
ton fichier en retour avec des lignes retirées qui ne servaient à rien
a+
Papou😱

 

[Paritec]

Re : Ajouter feuille suivant conditions

Bonjour Cathodique le forum
ton fichier en retour avec une petite modification sur la macro pour la V12
a+
Papou😱

 

[cathodique]

[RESOLU] : Ajouter feuille suivant conditions

Bonjour Paritec,

C'est exactement ce que je voulais obtenir, je t'en remercie beaucoup. Bravo!

Par rapport à ce que j'ai pu trouver sur le forum, j'ai voulu faire ce travail.
Mais vu mon faible niveau en VBA, je n'y suis pas parvenu.

wbkc.Close 1

pour cette ligne, je suppose que "1" signifie "True"?

Toute ma gratitude pour ton aide, ton fichier en retour et ta gentillesse de m'avoir consacré un peu de ton temps.

PS: les 2 versions fonctionnent bien.

Encore Merci.

Cordialement,

 

[Paritec]

Re : Ajouter feuille suivant conditions

Re bonjour Cathodique le forum
non le 1 signifie enregistrement
wbkc.close fermeture du fichier wbkc sans enregistrer les modifications
wbkc.close 1 fermeture du fichier wbkc avec enregistrement des modifications
a+
Papou😱

 

[cathodique]

Re : Ajouter feuille suivant conditions

Re,

Merci encore pour tes explications.

Bon week-end.

Cordialement,

 

[Paritec]

Re : Ajouter feuille suivant conditions

Re bonjour Cathodique le forum
merci toi aussi
a+
papou😱