XL 2013 Macro pour separer onglet sur bureau dans un dossier

[ArmelleM]

Bonjour à Tous,


Je recherche une macro permettant de dispatcher les onglets d'un fichier pour les mettre dans un dossier sur le bureau ?
J'ai une tache repetitive et dois séparer plus de 100 onglets avant de les envoyer par mail


D'avance Merci

ArmelleM

 

[Lone-wolf]

Re : Macro pour separer onglet sur bureau dans un dossier

Bonsoir ArmelleM,

code à inserer dans un module standard, ensuite appelle la macro par bouton "CreateFolder"

Private Declare Function SHCreateDirectoryEx Lib "Shell32.dll" Alias "SHCreateDirectoryExA" _
(ByVal hwnd As Long, ByVal pszPath As String, ByVal lngsec As Long) As Long

Sub CreationDossier(sNomRep As String)
SHCreateDirectoryEx 0&, sNomRep, 0&
End Sub

Sub CreateFolder()
Dim Rep As String, Nom As String
On Error Resume Next
Nom = Format(Date, "yyyy_mm_dd")
Rep = "C:\Users\" & Environ("username") & "\Desktop\" & Nom
CreationDossier Rep
Application.Wait (Now + TimeValue("00:00:01"))
Call SaveSheets
End Sub

Sub SaveSheets()
Dim Wsh, Chemin, Rep, Nm As String, x As Integer, Ws As Worksheet, sh
Set Wsh = CreateObject("WScript.Shell")
Nm = Format(Date, "yyyy_mm_dd")

Chemin = Wsh.SpecialFolders("Desktop") & "\" & Nm & "\"

For Each Ws In Worksheets
Ws.Activate
Ws.SaveAs Filename:= _
       Chemin & Ws.Name & ".xls", _
        FileFormat:=xlExcel8, CreateBackup:=False

     For Each sh In Ws.Shapes
    If sh.Type = 8 Then sh.Delete
  Next sh
Next Ws
Application.DisplayAlerts = False
ActiveWorkbook.Save
Application.Quit
End Sub

A+

 

[gosselien]

Re : Macro pour separer onglet sur bureau dans un dossier

Bonjour,

un morceau de ton fichier peut être ?
Ça aiderait

P.

 

[cathodique]

Re : Macro pour separer onglet sur bureau dans un dossier

Salut tout le monde,

Si j'ai bien compris, tu veux créer pour chaque onglet un classeur où il n'y que l'onglet concerné.

Alors remplace la macro de Lone-wolf (que je salue!) par celle-ci

Sub dispatch_Une_Par_Une() 
Dim Ws As Worksheet, nf$
For Each Ws In Worksheets
nf = Ws.Name
Ws.Copy
ActiveWorkbook.SaveAs Filename:=Rep & "\" & nf & ".xlsx"
ActiveWorkbook.Close True
Next Ws
End Sub

N'oublie pas de remplacer l'appelle dans la macro CreateFolder.

Bon dimanche à toutes et à tous.

 

[Lone-wolf]

Re : Macro pour separer onglet sur bureau dans un dossier

Bonjour à tous,

@cathodique: tu à mal compris

De ArmelleM
Je recherche une macro permettant de dispatcher les onglets d'un fichier pour les mettre dans un dossier sur le bureau

@gosselien: pas besoin qu'elle mette un fichier, tu insère 7 feuilles(à part les 3 par défaut) et tu test le code que j'ai mis.


@Armelle : c'est ce que fais la macro que j'ai mis.



A+

 

[cathodique]

Re : Macro pour separer onglet sur bureau dans un dossier

Salut Le Loup,

J'ai une tache repetitive et dois séparer plus de 100 onglets avant de les envoyer par mail

Possible que je me trompe, je suis référé à la 2ème phrase.

Elle peut choisir ainsi une des solutions à adapter selon ses besoins.

Cordialement,

Désolé pas fait attention que c'était une dame. Toutes mes excuses pour la confusion. Gaffe vite réparée.

 

[Lone-wolf]

Re : Macro pour separer onglet sur bureau dans un dossier

Re cathodhique,

je comprend, mais elle n'a pas spécifié dans son premier message si elle voulais avoir le choix des onglets. Dans ce cas la macro que j'ai mis n'est pas adaptée.


A+

 

[ArmelleM]

Re : Macro pour separer onglet sur bureau dans un dossier

Bonjour à vous,
vous étés vraiment, mais vraiment super de m'avoir répondu je crois que je suis un peu perdue ( oui je suis une fille ) tellement vous etes efficaces. En fait, je vais essayer par la plus simple - mon niveau est débutant avancée-

alors oui, je recois un fros fichier excel, ou les onglets sont nommées, et en réalité je dois envoyé chaque onglet à son destinataire, d'ou la macro pour tout séparer, dispatcher, mais dans un dossier sur le bureau pour travaileller rapidemnt

en fait, grace en lisant vos forums j'ai pu recopier une formule qui marche mais à moitié car elle bogue à F.Copy... bon, je vous la copie colle
Sub dispatch_Une_Par_Une()
Dim chemin As String, F As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
chemin = CreateObject("WScript.Shell").specialFolders("Desktop")
chemin = chemin & "\" & Format(Date, "yyyy_mm_dd")

If Dir(chemin, vbDirectory) = "" Then 'repertoire n'existe pas
MkDir chemin 'creation du repertoire
End If
For Each F In Worksheets
F.Copy
With ActiveWorkbook
.SaveAs Filename:=chemin & "\" & .ActiveSheet.Name & ".xlsx"
.Close True
End With
Next F
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub


si vous voyer l'erreur?

je vais essayer celles que vous m'avez proposé, merci beaucoup à vous !

 

[cathodique]

Re : Macro pour separer onglet sur bureau dans un dossier

Envoie-nous un petit fichier avec des données bidons.

Normalement, tu prends ce code et ça fonctionne bien.

Private Declare Function SHCreateDirectoryEx Lib "Shell32.dll" Alias "SHCreateDirectoryExA" _
(ByVal hwnd As Long, ByVal pszPath As String, ByVal lngsec As Long) As Long

Sub CreationDossier(sNomRep As String)
SHCreateDirectoryEx 0&, sNomRep, 0&
End Sub

Sub CreateFolder()
Dim Rep As String, Nom As String
On Error Resume Next
Nom = Format(Date, "yyyy_mm_dd")
Rep = "C:\Users\" & Environ("username") & "\Desktop\" & Nom
CreationDossier Rep
Application.Wait (Now + TimeValue("00:00:01"))
Call dispatch_Une_Par_Une
End Sub

Sub dispatch_Une_Par_Une()
Dim Ws As Worksheet, nf$
For Each Ws In Worksheets
nf = Ws.Name
Ws.Copy
ActiveWorkbook.SaveAs Filename:=Rep & "\" & nf & ".xlsx"
ActiveWorkbook.Close True
Next Ws
End Sub

2 macros de Lone-wolf et 1 de cathodique. Un dossier sera créé sur le bureau dans lequel tu trouveras le même nombre de fichiers que les onglets de ton fichier.

Pour éditer du code, la prochaine fois clique sur le #.

Bon dimanche.

 

[cathodique]

Re : Macro pour separer onglet sur bureau dans un dossier

Armelle, il fallait rester sur ton fil. ça ne sert à rien de poser la même question sur une autre discussion.

Tiens ouvre le fichier joint, fait Ctrl+m la macro va s’exécuter. sur le bureau tu trouveras un dossier nommé "2016_03_19"

à chaque exécution de la macro, un dossier sera créé et son nom sera la date du jour.

 

[ArmelleM]

Re : Macro pour separer onglet sur bureau dans un dossier

Je suis nouvelle désolée je cafouille je vais tester ta macro merci beaucoup

 

[ArmelleM]

Re : Macro pour separer onglet sur bureau dans un dossier

Ta macro est génial mais tout mes onglets non pas été pris en compte. Bon je vais arrêter de vous embeter ce que vous avez fait est deja tellement génial. deja celle d'avant avait fonctionné, tout les onglets etaient sur le dossier mais ils n'étaient pas separés, la ils sont bien isolés mais ca n'a pas tout pris; Désolée cathoqieu j'arrete de t'embeter, cette tache me prend tellement la tete ! MERCI ENCORE MILLE FOIS

 

[ArmelleM]

Re : Macro pour separer onglet sur bureau dans un dossier

mais tu avais bien compris cathodique merci vraiment de ton soutien ce forum est genial

 

[ArmelleM]

Re : Macro pour separer onglet sur bureau dans un dossier

j'ai teste sur un petit fichier ca va mais sur mon fichier de 170 seuls 44 sont sortis; voila voila merci

 

[cathodique]

Re : Macro pour separer onglet sur bureau dans un dossier

Bonjour Armelle,

Je crois que les 44 onglets non pris en compte portent des noms avec des caractères spéciaux. Non acceptés par excel pour le nommage des fichiers. Corrige le nom des onglets.

Je viens de créer plus 300 fichiers.

Dans la macro CreateFolder, supprime cette ligne ou mets une apostrophe au début

Application.Wait (Now + TimeValue("00:00:01"))