Sauvegarger un fichier dans un répertoire en fonction de la valeur d' une cellule

[Ab68]

Bonsoir le forum
Je bute sur le code qui permet de sauvegarder un fichier Excel dans un répertoire déjà crée ou crée par la macro.
La référence est la cellule "G1" ( une année transformée en texte par formule CTXT) du fichier.
Le nom du fichier est extrait de la cellule "A1".
Le code ci dessous me crée un répertoire ANNEE au lieu de la valeur texte en "G1" qui est 2013.

Dim ANNEE As String
ANNEE = Range("G1").Text

If Dir(ThisWorkbook.Path & "\ANNEE", vbDirectory) = "" Then MkDir ThisWorkbook.Path & "\ANNEE"
ActiveWorkbook.SaveAs "D:\Mes documents\CCS\ANNEE\" & (ActiveWorkbook.Worksheets(1).Range("A1").Text & ".xls")

Petite précision ce code bloque si je réponds Non ou Annuler à la boîte de dialogue lors de l' enregistrement.
Chemin du fichier initial: D:\Mes documents\CCS\"Compil randos printemps"
Chemin de sauvegarde: D:\Mes documents\CCS\2013\"Compil randos printemps 2013"
\2014\"...."
Le fichier est rempli par macro, trié et lignes nulles supprimées avant enregistrement, le nom modifié me permet de le différencier facilement.

Merci aux contributeurs qui auront pris la peine de me lire et m' apporteront une solution.

 

[Orodreth]

Re : Sauvegarger un fichier dans un répertoire en fonction de la valeur d' une cellul

Bonjour,

Ton code bloque parce que tu utilises un texte "ANNEE" au lieu d'utiliser ta variable.

Ci-dessous, la correction a apporté.

If Dir(ThisWorkbook.Path & "\" & ANNEE, vbDirectory) = "" Then MkDir ThisWorkbook.Path & "\" & ANNEE
ActiveWorkbook.SaveAs "D:\Mes documents\CCS\" & ANNEE & "\" & (ActiveWorkbook.Worksheets(1).Range("A1").Text & ".xls")

Cordialement,
Orodreth

 

[Ab68]

Re : Sauvegarger un fichier dans un répertoire en fonction de la valeur d' une cellul

Bonjour Orodreth
Super ça fonctionne
Sans vouloir abuser, petite question subsidiaire, déjà posée hier soir, comment quitter sans "buger" si réponse Non ou Annuler à l' invite d' enregistrer.
MERCI pour ce dépannage ultra rapide.
Cordiales salutations

 

[Orodreth]

Re : Sauvegarger un fichier dans un répertoire en fonction de la valeur d' une cellul

Re,

Il faut que tu joues sur

    ThisWorkbook.Close (False)

En gros, ça se traduit par "CeClasseur.Fermer(Sauvegarder = Faux)"

Cordialement,

 

[grisan29]

Re : Sauvegarger un fichier dans un répertoire en fonction de la valeur d' une cellul

bonjour ab68, Orodreth et le forum

voici un code qui met de sauvagarder le fichier par la croix en fonction du nom qui se trouve en cell "g17" dans l'exemple,peut etre peut tu en tirer quelque chose

Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error GoTo erreur
varname = Sheets("Feuil1").Range("g17").Value
fname = InputBox("enregistrer le fichier sous le nom", "Enregistrement", varname)
ActiveWorkbook.SaveAs Filename:=fname
Exit Sub
erreur:
rep = MsgBox("Une erreur c'est produite, voulez vous quitter sans sauvegarder", vbYesNo)
If rep = 7 Then Cancel = True
End Sub

Pascal

 

[Ab68]

Re : Sauvegarger un fichier dans un répertoire en fonction de la valeur d' une cellul

Bonsoir Pascal
Je vais essayer de transposer ce code dans mon fichier.
Merci pour cette recherche
Cordialement

 

[Gwendoline]

Re : Sauvegarger un fichier dans un répertoire en fonction de la valeur d' une cellul

Bonjour,

Quelqu'un peut me dire ce qui bogue dans ma VBA :

Sheets("BdC").Select
nbdc = Format(Now, "yyyy"" ""mmdd""_""hhmmss")

nbdc = Range("n49") & " " & nbdc

Range("A5") = nbdc
'Enregistrement du Bon de Commande sur le PC de l'acheteur

Dossier = WorksheetFunction.VLookup(Range("N49"), Range("Code_Dep"), 2, False)

If Dir(ThisWorkbook.Path & "\" & Dossier, vbDirectory) = "" Then MkDir ThisWorkbook.Path & "\" & Dossier
ActiveWorkbook.SaveAs Dossier & "\" & nbdc & ".xlsx"
End If

Exit Sub

Ca me plante à If Dir(ThisWorkbook.Path...

Grrrrr mais merci par avance. et puis fermer sans boguer, c'est génial ça, je suis fascinée