macro pour enregistrer des feuilles dans un nouveau fichier

B

brice_mhc

XLDnaute Nouveau
Bonsoir le fil,

je cherche une macro qui permette d'enregistrer les feuilles d'un fichier excel dans un nouveau classeur.
j'ai joins un mini exemple du fichier sur lequel je travaille.
En fait, je souhaite seulement enregistrer les feuilles portant le nom d'une personne dans un nouveau fichier c'est à dire les feuilles "alphand", "darmon", "nalis" et "langlois".
d'autre part je souhaiterais donner un nom specifique à ces fichiers en fonction du nom de la feuille.
Ainsi, le fichier dans lequel serait enregistré la feuille "darmon" se nommerait darmon_coeurdecible.xls et serait enregistré dans
O:\Mes documents\majeures\coeurdecible
Le fichier de base sur lequel je travaille est lui enregistré dans
O:\Mes documents\majeures

Voila. J'espère que je me suis bien expliqué.
Je ne sais pas si c'est possible de créer une telle macro
Merci par avance de votre aide

Brice
 

Pièces jointes

  • demo_tri.xls
    34 KB · Affichages: 203
Trier par date Trier par votes
Dan

Dan

XLDnaute Barbatruc
Re : macro pour enregistrer des feuilles dans un nouveau fichier

Bonsoir,

essaie en plaçant ces deux macros dans un module l'une à la suite de l'autre.
Code: 
Sub Archive()
'Macro archivage par DAN pour brice_mhc le 09/10/06
'http://www.excel-downloads.com/forum/68469-macro-pour-enregistrer-des-feuilles-dans-un-nouveau-fichier.html
Dim W As Worksheet
Dim nomfichier As Workbook
With Application
   .ScreenUpdating = False
   .DisplayAlerts = False
End with
On Error Resume Next
For Each W In ThisWorkbook.Sheets
    W.Activate
    If W.Name = "darmon" Or W.Name = "langlois" Or W.Name = "nalis" Or W.Name = "alphand" Then
    W.Copy
    Call sauve
    End If
Next W
Application.ScreenUpdating = True
End Sub
Code: 
Sub sauve()
'Macro sauvegarde dans répaertoire par DAN pour brice_mhc le 09/10/06
'http://www.excel-downloads.com/forum/68469-macro-pour-enregistrer-des-feuilles-dans-un-nouveau-fichier.html
Dim chemin As String
With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
chemin = "O:\Mes documents\majeures\coeurdecible\"
End With
With ActiveWorkbook
.SaveAs Filename:=chemin & ActiveSheet.Name & Format(Now(), "ddmmyy") & ".xls"
.Close
End With
Application.ScreenUpdating = True
End Sub

J'ai ajouté une date dans le nom du fichier.

Si pb n'hésite pas

A bientôt
 
Dernière édition:
Vote positif 0 Vote négatif
B

brice_mhc

XLDnaute Nouveau
Re : macro pour enregistrer des feuilles dans un nouveau fichier

Bonjour Dan, Allegro et le forum

Merci beaucoup pour vos aides.
J'ai testé les 2 possibilités sur mon mini-fichier et ca marche dans les 2 cas.
Par contre, pour le fichier réel sur lequel je souhaitais appliquer la macro, j'ai utilisé la méthode d'allegro car le fichier véritable comportait une centaine d'onglets et la methode de Dan ne nécessitait pas de recopier les noms des onglets dans la macro.

En tout cas merci encore à vous pour vos aides.

J'avais quelque chose d'autres à vous demander.
En effet, une fois les fichiers par nom créés, je souhaiterais les envoyer à des personnes distinctes.
Ainsi, le fichier alphand_coeurdecible.xlx serait envoyé à une personne
Puis le fichier nalis_coeurdecible.xls à une autre personne etc...

J'ai joint un fichier excel avec la liste de chaque destinataire pour chaque fichier. j'ai mis mon nom en face de chaque fichier volontairement afin que je puisse d'abord faire un petit test sur ma boite mail.

J'ai entendu parler de la méthode sendmail mais je ne sais pas si ca pourrait marcher.

Je vais m'appuyer sur la macro proposée par allegro pour les emplacements des fichiers
la liste des destinataires est enregistrée dans "C:\temp" et les 4 fichiers coeur de cibles sont dans "C:\temp\coeur_de_cible".

Voila

Merci d'avance

Brice
 

Pièces jointes

  • liste_destinataire.xls
    16.5 KB · Affichages: 223
Vote positif 0 Vote négatif
pierrejean

pierrejean

XLDnaute Barbatruc
Re : macro pour enregistrer des feuilles dans un nouveau fichier

bonjour

voici une macro péchée ici et dont je n'ais malheureusement pas repris le nom de l'auteur

Code: 
Sub EnvoilaFeuilparMail()
'envoi d'une feuille
'par contre je ne connais pas la syntaxe pour mettre du texte
Dim Wbk As Workbook
ThisWorkbook.Sheets("Feuil1").Copy
Set Wbk = ActiveWorkbook
SendKeys "{E}"
Wbk.SendMail "[EMAIL="mon.adresse@free.fr"]mon.adresse@free.fr[/EMAIL]", "Feuille 1", True
'true pour un avis de reception
Wbk.Close savechanges:=False
Set Wbk = Nothing
End Sub

ps: j'ai d'autres methodes notamment avec outlook express
 
Vote positif 0 Vote négatif
Dan

Dan

XLDnaute Barbatruc
Re : macro pour enregistrer des feuilles dans un nouveau fichier

Bonsoir,

J'ai fait un genre d'appli qui envoie le ficher d'excel en pièce jointe sur outlook. Toutefois, le choix des personnes est fait au travers d'outlook et non pas préprogrammé dans excel (trop compliqué si quelque chose change dans les destinataires par exemple). Donc plus simple car si ton carnet d'adresse est rempli, il te suffit de choisir les destinataires là.
Si cela te convient, je te donnerai cette macro à ajouter à celle que je t'ai proposée avant.

A te lire

;)
 
Vote positif 0 Vote négatif
pierrejean

pierrejean

XLDnaute Barbatruc
Re : macro pour enregistrer des feuilles dans un nouveau fichier

bonjour brice
Salut Dan

3 macros pour envoi de mail dont 2 avec outlookexpress (adresses notées comme le carnet d'adresses ou integrales)

Code: 
Sub MailFeuilleOE()
'd'apres une macro de Laurent LONGRE transmise par MICHELXLD
Dim Dest As String, Sujt As String, Msg As String
Dim RepName As String
Dim copie As String
ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:="C:\temp\test.xls"
RepName = "C:\temp\test.xls"
Dest = "[EMAIL="mon.adresse@free.fr"]mon.adresse@free.fr[/EMAIL]"
'noter le &cc= entre les differentes adresses en copie
copie = "[EMAIL="mon.adresse1@free.fr&cc=monadresse2@free.fr"]mon.adresse1@free.fr&cc=monadresse2@free.fr[/EMAIL]"
Sujt = "Test d'envoi d'une feuille avec Excel"
Msg = "Bonjour, Excel vous envoie une feuille avec Outlook Express"
Shell "C:\Program Files\Outlook Express\msimn.exe " & _
"/mailurl:mailto:" & Dest & "?cc=" & copie & "&subject=" & Sujt & "&Body=" & Msg & ""
SendKeys "%I" & "p" & RepName & "~" & "%s"
ActiveWorkbook.Close
End Sub
 
Sub MailFichierOE()
'd'apres une macro de Laurent LONGRE transmise par MICHELXLD
Dim Dest As String, Sujt As String, Msg As String
Dim RepName As String
Dim copie As String
ActiveWorkbook.SaveCopyAs "C:\temp\test.xls"
RepName = "C:\temp\test.xls"
Dest = "[EMAIL="mon.adresse@free.fr"]mon.adresse@free.fr[/EMAIL]"
'noter le &cc= entre les differentes adresses en copie
copie = "[EMAIL="sec.adresse@free.fr&cc=tri.adresse@free.fr"]sec.adresse@free.fr&cc=tri.adresse@free.fr[/EMAIL]"
Sujt = "Test d'envoi d'un fichier avec Excel"
Msg = "Bonjour, Excel vous envoie un fichier avec Outlook Express"
Shell "C:\Program Files\Outlook Express\msimn.exe " & _
"/mailurl:mailto:" & Dest & "?cc=" & copie & "&subject=" & Sujt & "&Body=" & Msg & ""
SendKeys "%I" & "p" & RepName & "~" & "%s"
End Sub
 
Sub envoimail()
Workbooks("Mail.xls").HasRoutingSlip = True
With Workbooks("Mail.xls").RoutingSlip
    .Delivery = xlAllAtOnce
    .Recipients = Array("[EMAIL="adresse1@free.fr"]adresse1@free.fr[/EMAIL]", _
        "[EMAIL="adresse2@free.fr"]adresse2@free.fr[/EMAIL]", "[EMAIL="adresse3@free.fr"]adresse3@free.fr[/EMAIL]")
    .Subject = "Le fichier"
    .message = "comment allez vous ?? "
End With
ActiveWorkbook.Route
End Sub
 
Vote positif 0 Vote négatif
Dan

Dan

XLDnaute Barbatruc
Re : macro pour enregistrer des feuilles dans un nouveau fichier

Re,

Ok.
Essaie e remplaçat la macro Sauve par celle ci après
Code: 
Sub sauve()
'Macro archivage par DAN pour brice_mhc le 09/10/06
'Post http://www.excel-downloads.com/forum/68469-macro-pour-enregistrer-des-feuilles-dans-un-nouveau-fichier.html
Dim chemin As String, nomfichier As String
With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
End With
chemin = "O:\Mes documents\majeures\coeurdecible\"
nomfichier = chemin & ActiveSheet.Name & Format(Now(), "ddmmyy") & ".xls"
With ActiveWorkbook
.SaveAs Filename:=nomfichier
Application.Dialogs(xlDialogSendMail).Show
.Close
End With
Application.ScreenUpdating = True
End Sub

A te lire
 
Vote positif 0 Vote négatif

Discussions similaires

_l_ours
  • Résolu(e)
XL 2016 Copier un onglet dans un nouveau classeur excel et l'enregistrer
Réponses
3
Affichages
156
sylvanu
sylvanu
N
  • Résolu(e)
Microsoft 365 Je ne peux plus ouvrir mon fichier Excel sur Mac
Réponses
10
Affichages
217
Nicolas777B
N
J
  • Question
XL 2019 créer un nouveau dossier contenant fichier
Réponses
4
Affichages
243
patricktoulon
patricktoulon
P
  • Question
Microsoft 365 VBA - Enregistrer un fichier en pdf dans un dossier dont on ne connait que les 4 premiers caractères
Réponses
2
Affichages
199
phil75016
P
L
  • Question
Microsoft 365 Macro choisir onglet à exporter dans un nouveau classeur
Réponses
5
Affichages
344
l.et.lilou
L
D
  • Question
Microsoft 365 Copier dans un nouveau fichier un fichier Excel contenant des macros
Réponses
2
Affichages
163
Daniel200666
D
P
  • Résolu(e)
Microsoft 365 creer un dossier et sauvergarder un fichier PDF avec le meme nom
Réponses
5
Affichages
299
Lolote83
L
Wissem
  • Question
XL 2016 exporter des images dans un dossier
Réponses
1
Affichages
193
fanch55
fanch55
G
  • Question
Microsoft 365 Saut de ligne dans une cellule
Réponses
3
Affichages
120
GClaire
G
C
  • Question
XL 2016 Enregistrer sous un nom de fichier est proposé.
Réponses
4
Affichages
368
caloger
C

Membres actuellement en ligne

19 membres et 152 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 045
Messages
2 084 834
Membres
102 685
dernier inscrit
med_remi021