Modifier chemin sauvegarde sous

bonjour a tous et toutes

je voudrais pouvoir changer le chemin de sauvegarde de mes factures en les mettant dans un dossier année dans le quel il y a les mois

pour l'instant les devis et factures sont sauvé chacun dans son dossier sur d: via ce code

Public Sub envoifacnue() 'sans les boutons et codes

Dim F As Worksheet
Dim Chemin As String
Dim Client As String
Dim Sh As Shape

  Set F = ThisWorkbook.Sheets(WS_FACTURE)

  Select Case F.Range("D1")
  Case "DEVIS"
    Chemin = "D:\Facturation-v1s\factureseule\devis\"
  Case "FACTURE ACOMPTE"
    Chemin = "D:\Facturation-v1s\factureseule\facture acompte\"
  Case "FACTURE ACQUITTEE"
    Chemin = "D:\Facturation-v1s\factureseule\facture acquittée\"
  Case "FACTURE"
    Chemin = "D:\Facturation-v1s\factureseule\factures\"
  Case Else
    MsgBox "Impossibilité de déterminer le chemin" & vbCr & "Fin du programme"
    End
  End Select

  Client = F.Range("DOC_TITRE") & " - " & F.Range("DOC_CLIENT")

  Application.ScreenUpdating = False

  F.Copy
  With ActiveWorkbook
    With .Sheets(1)
      For Each Sh In .Shapes
        If Sh.Type <> msoPicture Then
          Sh.Delete
        End If
      Next Sh
F.Cells(3, 1) = F.Cells(3, 1).Value
      .Cells.Copy
      .Range("A1").PasteSpecial Paste:=xlPasteValues
      .Range("A1").Select
    End With
    Application.DisplayAlerts = False  ' Si fichier identique présent : l'écrase sans alerte
   .SaveAs Filename:=Chemin & Client & ".xlsx"
    .Close
  End With
End Sub

c'est un code qui sauve la feuille en l'ayant débarrasser de ses code et boutons

je pense qu'il faut modifier les "case"mais je n'arrive pas a le faire bien car en plusil faudrai que la sauvegarde s'occupe de changer de mois au 30 où 31 et pareil pour les années et c'est la que je pêche voici un aperçu de comment est mon chemin

c'est sur quand je clique sur une année il y a les mois qui arrivent en sous dossiers

Bonjour

un essai a adapter car j'ai pris comme chemin de départ le chemin du classeur actif....

et donc utiliser schemin au lieu de ton chemin

fred

Sub find_dossier()
Dim mois$, annee$
Dim schemin$
annee = "\" & Year(Date)
mois = "\" & Month(Date) &"\"
schemin = ThisWorkbook.Path & annee
If Dir(schemin, vbDirectory) = "" Then MkDir schemin
schemin = ThisWorkbook.Path & annee & mois
If Dir(schemin, vbDirectory) = "" Then MkDir schemin
End Sub

EDIT voici ton code modifié

fred

Public Sub envoifacnue() 'sans les boutons et codes

Dim F As Worksheet
Dim Chemin As String
Dim Client As String
Dim Sh As Shape
Dim mois$, annee$
Dim schemin$

  Set F = ThisWorkbook.Sheets(WS_FACTURE)

  Select Case F.Range("D1")
  Case "DEVIS"
    Chemin = "D:\Facturation-v1s\factureseule\devis\"
  Case "FACTURE ACOMPTE"
    Chemin = "D:\Facturation-v1s\factureseule\facture acompte\"
  Case "FACTURE ACQUITTEE"
    Chemin = "D:\Facturation-v1s\factureseule\facture acquittée\"
  Case "FACTURE"
    Chemin = "D:\Facturation-v1s\factureseule\factures\"
  Case Else
    MsgBox "Impossibilité de déterminer le chemin" & vbCr & "Fin du programme"
    End
  End Select

annee =  Year(Date) & "\"
mois =  Month(Date) & "\"
schemin = Chemin  & annee
If Dir(schemin, vbDirectory) = "" Then MkDir schemin
schemin = Chemin  & annee & mois
If Dir(schemin, vbDirectory) = "" Then MkDir schemin

  Client = F.Range("DOC_TITRE") & " - " & F.Range("DOC_CLIENT")

  Application.ScreenUpdating = False

  F.Copy
  With ActiveWorkbook
    With .Sheets(1)
      For Each Sh In .Shapes
        If Sh.Type <> msoPicture Then
          Sh.Delete
        End If
      Next Sh
F.Cells(3, 1) = F.Cells(3, 1).Value
      .Cells.Copy
      .Range("A1").PasteSpecial Paste:=xlPasteValues
      .Range("A1").Select
    End With
    Application.DisplayAlerts = False  ' Si fichier identique présent : l'écrase sans alerte
  .SaveAs Filename:=schemin & Client & ".xlsx"
    .Close
  End With
End Sub

bonjour fred2406

merci beaucoup de ta réponse , ca y est presque mais pas tout a fait car la sauvegarde va dans la bonne année mais créer un nouveau dossier nommé au numéro du mois au lieu d'aller dans le mois concerné, vois l'aperçu

c'est pas cela du tout que j'ai essayer de faire, mais c'est mieux comme tu le fais Merci

Bonjour,

sans tester :

mois =  format(Date,"mmmm") & "\"

eric

bonjour ériiic

merci de ta réponse qui finalise le code de fred2406

je teste plus et si c'est bon je met en résolu ce post

Merci a vous 2

c'est une affaire rondement menée par vous 2 merci beaucoup