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