Sauvegarde Classeur avec 3 cellules différentes

[Socko]

Bonjour à tous,

J'aimerais savoir si l'on peux sauvegarder un fichier excel via un bouton avec la possibilité d'avoir un nom composé de plusieurs cellules.

Je m'explique

J'ai un chemin situé en "N1" sur un serveur commun.
Le numéro de semaine en "K9:K10:K11" (cellule fusionnée)
Une date situé en "C4 et D4 " (cellule fusionnée)
Le nom d'un fournisseur "D5:E5:F5:G5:H5:I5:J5:K5" ( cellule fusionnée + sélection par liste)

En gros: Dans le serveur \\r33f07127\ech_Pessac_DISTRI_PFM\RECEPTION

nom du fichier : "40_26.09.17_Airbus"

Merci de votre aide.

Simon

 

[Sequoyah]

Bonjour Socko et le Forum,

voici un fichier exemple et le code:

Sub Sauvegarde()
   
    Dim NomFichier           As String
    Dim Chemin           As String
    Dim NouveauFichier         As Workbook
   
    Application.ScreenUpdating = False
   
    Chemin = Range("N1").Value
   
    NomFichier = Range("K9").Value & "_" & Format(Range("C4").Value, "dd.mm.yy") & "_" & Range("D5").Value & ".xlsx"
   
    Set NouveauFichier = Workbooks.Add
   
    ThisWorkbook.ActiveSheet.Copy Before:=NouveauFichier.Sheets(1)
   
    If Dir(Chemin & "\" & NomFichier) <> "" Then
   
        MsgBox "Le fichier " & Chemin & "\" & NomFichier & " existe déjà!"
       
    Else
       
        NouveauFichier.SaveAs Filename:=Chemin & "\" & NomFichier
       
    End If
   
    Application.DisplayAlerts = False
   
    NouveauFichier.Worksheets(2).Delete 'Supprime la feuille vide
   
    ActiveSheet.DrawingObjects.Delete 'Efface le bouton
    NouveauFichier.Close
   
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
   
End Sub

 

[job75]

Bonsoir Socko, Sequoyah,

Si le fichier à sauvegarder est bien enregistré on peut utiliser SaveCopyAs :

Sub Sauvegarder()
On Error Resume Next 'si le chemin n'est pas correct ou s'il y a des caractères interdits
With ThisWorkbook
.SaveCopyAs [N1] & "\" & [K9] & "_" & Format([C4], "dd.mm.yy") & "_" & [D5] & Mid(.Name, InStrRev(.Name, "."))
End With
End Sub

A+