Enregistrement par macro dans répertoire précis

[hyperion66]

Je voudrais que ma feuille soit enregistrée dans un répertoire précis (ça, c'est déjà fait), mais dans un sous répertoire de l'année en cours ou de l'année récupérée sur cette meme feuille.
Voilà mon code actuel :

Sub Enregistrement()
Dim Chemin1$, Chemin2$, Client$, Fichier$, Numfact$, Jour$
Chemin1 = "H:\Zerobug backup\Factures\"
Chemin2 = "D:\Gestion\Factures\"
Jour = Format(Now(), "ddmmyyyy")
Client = Range("H7")
Numfact = Range("I15")
Fichier = Jour & "_" & Numfact & ".xls"
If Dir(Chemin1 & Client, 16) = "" Then MkDir Chemin1 & Client
ActiveWorkbook.SaveAs Chemin1 & Client & "\" & Fichier
If Dir(Chemin2 & Client, 16) = "" Then MkDir Chemin2 & Client
ActiveWorkbook.SaveAs Chemin2 & Client & "\" & Fichier

Pour Chemin2 par exemple, pour une facture ayant comme date 2007, que la macro me l'enregistre dans D:\Gestion\Factures\2007\[Client]\Fichier.xls

Comment faire ?

Merci

[gbinforme]

Envoyé par hyperion66

...mais dans un sous répertoire de l'année en cours ou de l'année récupérée sur cette meme feuille.

en changeant cette ligne cela devrait le faire :

Chemin2 = "D:\Gestion\Factures\" & Format(Now(), "yyyy") & "\"

[hyperion66]

Malheureusement, non, ça me provoque une erreur au niveau du MkDir Chemin1 & Client ensuite.
Merci quand même !

[gbinforme]

bonsoir,

Comme tu introduis un répertoire supplémentaire, il faut aussi le créer, et donc rajouter :

If Dir(Chemin1 ), 16) = "" Then MkDir Chemin1


avant le contrôle :

If Dir(Chemin1 & Client, 16) = "" Then MkDir Chemin1 & Client

et idem pour Chemin2 bien sûr !

[hyperion66]

Désolé, étant débutant niveau VBA, je ne vois pas !

[gbinforme]

bonjour,

D'accord je te remet tout le code modifié :

Sub Enregistrement()
Dim Chemin1$, Chemin2$, Client$, Fichier$, Numfact$, Jour$
Chemin1 = "H:\Zerobug backup\Factures\" & Format(Now(), "yyyy") & "\"
Chemin2 = "D:\Gestion\Factures\" & Format(Now(), "yyyy") & "\"
Jour = Format(Now(), "ddmmyyyy")
Client = Range("H7")
Numfact = Range("I15")
Fichier = Jour & "_" & Numfact & ".xls"
If Dir(Chemin1 ), 16) = "" Then MkDir Chemin1
If Dir(Chemin1 & Client, 16) = "" Then MkDir Chemin1 & Client
ActiveWorkbook.SaveAs Chemin1 & Client & "\" & Fichier
If Dir(Chemin2 ), 16) = "" Then MkDir Chemin2
If Dir(Chemin2 & Client, 16) = "" Then MkDir Chemin2 & Client
ActiveWorkbook.SaveAs Chemin2 & Client & "\" & Fichier

Ainsi cela devrait fonctionner.

[hyperion66]

Merci beaucoup, c'est exactement ce que je cherchais.