Enregistrer feuille par selection user form

Bonjour,

J'ai un fichier ci joint avec plusieurs macros.

J'ai une macro sauvegarde qui fonctionne pas mal , le seul problème c'est que ça m'enregistre toutes les feuilles du classeur.

J'aimerais si c'est possible que ça me propose la feuille que je souhaite enregistrer comme sur la macro d’impression.

Merci pour votre aide.

Bonjour NJA31,

Pour illustrer, un exemple de ce qu'on peut faire (à adapter à votre cas) :

Sub test()
Dim wbk As Workbook
   Application.ScreenUpdating = False
   ActiveSheet.Copy           'création d'un nouveau classeur ne contenant que la feuille active
                              'remplacer ActiveSheet par la feuille à sauvegarder
   Set wbk = ActiveWorkbook   'wbk => représente le nouveau classeur
   wbk.SaveAs "c:\toto\copy04.xlsx"    'sauvegarde du nouveau classeur
   wbk.Close                           'fermeture du nouveau classeur
End Sub

Bonjour mafraise,

Merci pour ton retour

Dans ce code je n'ai pas l'option de choisir quelle feuille sauvegarder à partir de ma feuille de saisie et du bouton sauvegarde.

Re,

Dans ce code je n'ai pas l'option de choisir quelle feuille sauvegarder à partir de ma feuille de saisie et du bouton sauvegarde.

Voir le fichier joint :

• Cliquer sur le bouton Sauvegarder -> une boite de dialogue s'ouvre
• Sélectionner la feuille à sauvegarder et y sélectionner une cellule (n'importe laquelle)
• Cliquer sur le bouton OK de la boite de dialogue

Le code de la procédure :

Sub Sauvegarder()
Dim FileExtStr As String, FileFormatNum As Long, xWb As Workbook, xNewWb As Workbook
Dim FolderName As String, cellule As Range, xName As String

   Application.ScreenUpdating = False
   Set xWb = Application.ThisWorkbook
   FolderName = xWb.Path & "\" & xWb.Name & " " & Format(Now, "yyyy-mm-dd hh-mm")

   If Val(Application.Version) < 12 Then
      FileExtStr = ".xls": FileFormatNum = -4143
   Else
      Select Case xWb.FileFormat
      Case 51:
         FileExtStr = ".xlsx": FileFormatNum = 51
      Case 52:
         If Application.ActiveWorkbook.HasVBProject Then
            FileExtStr = ".xlsm": FileFormatNum = 52
         Else
            FileExtStr = ".xlsx": FileFormatNum = 51
         End If
      Case 56:
         FileExtStr = ".xls": FileFormatNum = 56
      Case Else:
         FileExtStr = ".xlsb": FileFormatNum = 50
      End Select
   End If
   MkDir FolderName

   Application.ScreenUpdating = True: On Error Resume Next
   Set cellule = Application.InputBox(prompt:="Sélectionnez une CELLULE de la feuille à sauvegarder SVP...", _
      Title:="Choix de la feuille à sauvegarder", Type:=8)
   Err.Clear: Application.ScreenUpdating = False
   If cellule Is Nothing Then
      MsgBox "Erreur de sélection d'une cellule de la feuille à sauvegarder => Echec!", vbCritical
      Application.Goto Sheets("Saisie").Range("a1"), True
      Exit Sub
   End If
   With cellule.Parent
      .Select
      .Copy
      Set xNewWb = ActiveWorkbook
      xName = FolderName & "\" & .Name & FileExtStr
      xNewWb.SaveAs xName, FileFormat:=FileFormatNum
      xNewWb.Close False
      MsgBox "Le fichier est enregistré sous " & xName
   End With
End Sub

Bonjour mafraise,

ça fait bien le boulot, je te remercie de ton aide et du temps consacré.

Bonjour mafraise,

j'ai chercher mais je n'y arrive pas , comment ne pas créer un nouveau dossier et enregistrer seulement avec le nom de la feuille et la date à la racine du dossier.

J'ai réussi à mettre la date sur le fichier mais je n'arrive pas à l’enregistrer à la racine .

Merci