Enregistrer et effacer fichier

bonsoir le forum!

j'ai ce code qui fonctionne trés bien,fournis par Banzai64

"Sub enregistrer()

Dim Chemin$, NomDossier$, SousDossier$, NomFichier$

'Chemin = Trim(Range("h4"))

Chemin = ThisWorkbook.Path & "\"

NomDossier = Trim(Range("h6"))

SousDossier = Trim(Range("h8"))

NomFichier = Trim(Range("h10")) & ".xlsm"

If Dir(Chemin & NomDossier, 16) = "" Then MkDir Chemin & NomDossier

If Dir(Chemin & NomDossier & SousDossier, 16) = "" Then MkDir Chemin & NomDossier & SousDossier

For Each cel1 In [Dossiers]

For Each cel2 In [SousDossiers]

If Dir(Chemin & cel1 & cel2 & NomFichier) <> "" Then

Kill Chemin & cel1 & cel2 & NomFichier

GoTo CestFait

End If

Next cel2

Next cel1

CestFait:

'Pour enregister une copie seulement

ActiveWorkbook.SaveCopyAs Chemin & NomDossier & SousDossier & NomFichier

End Sub"

j'ai essayer de le modifier pour ajouter un niveau de sous dossier mais j'y arrive pas

"Sub enregistrer()

Dim Chemin$, NomDossier$, SousDossier$, SousDossier1$, NomFichier$

Chemin = ThisWorkbook.Path & "\"

NomDossier = Trim(Range("h7"))

SousDossier = Trim(Range("h9"))

sousDossier1 = Trim(Range("h11"))

NomFichier = Trim(Range("h13")) & ".xlsm"

If Dir(Chemin & NomDossier, 16) = "" Then MkDir Chemin & NomDossier & SousDossier & SousDossier1

For Each cel1 In [Dossiers]

For Each cel2 In [SousDossiers]

For Each cel3 In [SousDossiers1]

If Dir(Chemin & cel1 & cel2 & cel3 & NomFichier) <> "" Then

Kill Chemin & cel1 & cel2 & cel3 & NomFichier

GoTo CestFait

End If

Next cel3

Next cel2

Next cel1

CestFait:

'Pour enregister une copie seulement

ActiveWorkbook.SaveCopyAs Chemin & NomDossier & SousDossier & SousDossier1 & NomFichier

End Sub"

quelqu'un peut-il m'aider pour corriger ce code, merci d'avance

Bonjour

Avec le fichier cela serait préférable

On ne sait pas où est l'erreur ni le type de l'erreur

bonsoir Banzai64!

excuse moi j'ai pensé que le code suffirai, je joint un fichier exemple et te remercie d'avance pour ton aide

Bonjour

La macro dans ton fichier n'est pas la même que celle que tu as posté

Des erreurs

If Dir(Chemin & NomDossier,NomDossier & SousDossier & SousDossierA, 16) = "" Then MkDir Chemin & NomDossier & SousDossier & SousDossierA

If Dir(Chemin & NomDossier & SousDossier & SousDossierA, 16) = "" Then MkDir Chemin & NomDossier & SousDossier & SousDossierA

Erreur à cette ligne

ActiveWorkbook.SaveCopyAs Chemin & NomDossier & SousDossier & SousDossier1 & NomFichier

A remplacer par

ActiveWorkbook.SaveCopyAs Chemin & NomDossier & SousDossier & SousDossierA & NomFichier

bonjour Banzai64!

Tous d'abord je m'excuse pour mon cafouillage entre fichier et code, j'espère que tu ne m'en tiendras pas rigeur

Un grand merci pour ton aide j'ai intégré ton code dans mon tableur est une fois adapté cela à fonctionner parfaitement.