Résolu Macro Excel pour créer classeurs à partir de feuilles

[Dicky-Bird]

Bonjour,

mes recherches étant resté vaines sur le sujet, je sollicite votre aide.

voila mon pb:
Je reçois tous les mois un fichier Excel contenant de 5 à 40 feuilles.
Je dois l'éclater en autant de classeurs que de feuilles :
ex:
j'ai un classeur "monclasseur" contenant les feuilles AAAA, BBBB et CCCC
je souhaiterais créer 1 classeur nommé AAAA avec la feuille AAAA
un autre nommé BBBB avec la feuille BBBB
et enfin un autre nommé CCCC avec la feuille CCCC

merci donc pour votre aide à la réalisation de cette macro,

Cordialement,

 

[tantal_fr]

Bonjour,

Voici un code vite-fait qui fait ça, il n'y a pas de gestion des erreurs, il faudra peut l'adapter à ton cas :

[cpp]Sub Macro2()
For Each feuille In ActiveWorkbook.Sheets
Set newBook = Workbooks.Add
With newBook
.Title = feuille.Name
.Subject = feuille.Name
.SaveAs Filename:=feuille.Name + ".xls"
End With

Next[/cpp]

Voila j'espère t'avoir aidé.

 

[Dicky-Bird]

Bonjour,

Merci pour cette réponse rapide;

La création des classeurs avec les noms des feuilles fonctionne très bien.

Par contre, la copie de la feuille en question n'est pas réalisée dans le nouveau classeur.

Cette fonction me ferait gagner enormément de temps;

Encore merci

Cordialement,

 

[tantal_fr]

Pardon, j'avais mal lu, voici :

[cpp]
Sub Macro2()

For Each feuille In ActiveWorkbook.Sheets
feuille.Copy
With ActiveWorkbook
.Title = feuille.Name
.Subject = feuille.Name
.SaveAs Filename:=feuille.Name + ".xls"
End With

Next
End Sub[/cpp]

 

[Dicky-Bird]

Merci beaucoup,

c'est super.

C'est précisément ce que je souhaitais.

cela va m'aider considérablement;

Cordialement,

 

[youcefe]

je suis novice
pouvez-vous m'envoyer le fichier avec un bouton pour la macro?
merci

 

[zeb]

Bonjour Youcefe,

Non pas question. Nous ne faisons pas d'échange de fichiers.
C'est à ce prix que nous nous préservons des virus.

 

[MagicVitalic]

Hello hello,

Je viens de tomber sur cette macro qui marche plutôt bien, même très bien, voire trop bien dans mon cas.

Comment est-ce que l'on fait pour ne copier que le contenu de la page courante?

J'imagine qu'il faut modifier la condition For Each feuille In ActiveWorkbook.Sheets mais j'ai jamais fait de VBA avant et je connais pas les fonctions

Merci d'avance et je m'excuse de ressusciter le topic

 

[zeb]

Cher MagicVtalic,

Les topics ne sont pas fermés automatiquement, pour qu'on puisse au besoin les "ressusciter".
Tu es donc le bienvenu.

--------------

Tu as donc ouvert un classeur pleins de feuilles et tu voudrais enregistrer la feuille courante dans un classeur à part.
C'est bien ça ?

Facile !

ActiveSheet.SaveAs Filename:=ActiveSheet.Name & ".xls"

Il convient maintenant de vérifier que le fichier n'existe pas, qu'on est bien dans le répertoire voulu, etc.
On continue ?

 

[MagicVitalic]

Hello hello!

C'est trop cool! c'est parfait!

Et au lieu de l'affecter à un bouton que je dois copier/coller dans chaque feuille, je peux l'ajouter en barre d'accès rapide. C'est surpuissant!

Merci Zeb

 

[zeb]

Mais de rien. Donc pas de problème de répertoire, de fichier déjà présent !

 

[MagicVitalic]

Non, en bidouillant le nom du nouveau fichier, j'arrive à ne pas créer d'erreur.
Mais sije veux lui dire de sauvegarder cette nouvelle feuille dans un répertoire qui se trouve au même niveau que le fichier dans lequel je me trouve. Qu'est-ce que je peux lui dire?

 

[zeb]

Le classeur ouvert et actif est représenté par l'objet ActiveWorkbook.
Tu peux te servir de sa propriété FullName qui contient le chemin et le nom du fichier.

Regarde. Je ne retire que l'extension (pour la remettre plus tard) mais j'ajoute le nom de la feuille à la fin du nom du classeur. Mal mal, non ? Je rajoute un éventuel compteur (N) pour être sûr de ne pas écraser un précédent fichier :

Dim FSO     As New FileSystemObject
Dim sExt    As String
Dim sRootFN As String
Dim N       As Integer
Dim sFullFN As String

sExt    = fso.GetExtensionName(ActiveWorkBook.Fullname)
sRootFN = Left(ActiveWorkBook.Fullname, Len(sExt)-1) & "_" & ActiveSheet.Name

N = 0
Do 
	sFullFN = sRootFN & Iif(N = 0, "", "_" & N) & "." & sExt
	N = N + 1	
Loop While FSO.FileExists(sFullFN)

ActiveSheet.SaveAs Filename:=sFullFN

Si FileSystemObject ne fait pas partie de tes références dans Excel, alors la première ligne doit être remplacée par :

Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")

 

[drul]

Hello,
Remarque, on peut également faire ça avec l'aide de activeworkbook.path et de la commande dir

 

[zeb]

Salut mon cher Drul


+1 pour la méthode Path.

Mais oulala que je n'aime pas la commande Dir(), pleine de fuites mémoire.
Et comment fais-tu pour savoir si le fichier existe, sachant qu'il est interdit de répondre "Je déclenche une exception" ?

 

[zeb]

Oups, la commande Dir() renvoie une chaîne vide si le fichier n'existe pas.
Donc pas de problème avec la gestion des erreurs. Les fuites mémoires restent vraies.

 

[drul]

Re-Salut maître Zeb [:coucou],
Je ne savais pas pour les fuites mémoires, je l'ai souvent utilisé sans soucis.

 

[zeb]

En fait, Dir() lit tout le contenu du répertoire et stocke le tout dans des variables globales.
Utiliser cette fonction en VBA dans une petite macro ne porte pas à conséquence.
Il n'en va pas de même dans une grosse application développée en Visual Basic.

D'où mon aversion pour cette fonction. Mais je ne t'empêche pas de l'utiliser, ni même de la proposer à MagicVitalic

 

[MagicVitalic]

Merci pour ton intervention Drul

Je pourrais intégrer Dir() comment alors, dans ma fonction?

 

[drul]

Un exemple (avec un peu de récursivité, parce qu'il faut bien s'amuser )

Sub MaSub()
    savesheet (0)
End Sub
Sub savesheet(index As Integer)
Dim TargetName As String
TargetName = ActiveWorkbook.Path & "\" & ActiveSheet.Name & "_" & index & ".xls"
If Dir(TargetName) = "" Then
    ActiveSheet.SaveAs Filename:=TargetName
Else
    savesheet (index + 1)
End If
End Sub

Tu dois faire un appel a MaSub()
Le résultat doit être assez proche de celui de Zeb.