Générer des fichiers à partir d'onglets

Version imprimable

1 pièce(s) jointe(s)

Bonjour à vous tous,
tout d'abord je tiens à vous informer du fait que mon niveau en macro est faible mais j'ai une grande soif d'apprendre. De plus, j'ai cherché sur différents forum des posts à ce sujet sans toutefois obtenir de réponse.
Donc voilà, je souhaite générer des fichiers Excels à partir d'onglets d'un fichier source.
J'ai donc enregistré une macro qui copie un onglet, le colle en valeur dans un nouveau fichier, enregistre, et ferme ce dernier.
Vous trouverez ci-joint l'exemple. Comme mon fichier final comportera de nombreuses feuilles (0001, 0002, etc.), je voudrais passer par un code qui permettre de faire une sorte de boucle pour générer à la suite du fichier "0001", un fichier qui se nomera "0002" à partir de l'onglet 0002, dans le même emplacement sur le disque dur et ainsi de suite. Le code irai si possible chercher les noms des feuilles dans la feuille "liste onglets".
N'hésitez pas à me poser des questions si je n'ai pas été clair.
Je vous remercie par avance de votre aide.
Edouard
Edit: Voici le Code (j'ai essayé de poster le fichier en .xlsm mais ca n'a pas fonctionné)
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Sub Sales_Report() ' Sheets("0001").Select Sheets("0001").Copy Cells.Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("A1").Select Application.CutCopyMode = False ActiveWorkbook.SaveAs Filename:= _ "D:\Documents and Settings\user\My Documents\Report\0001.xlsx" _ , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False ActiveWindow.Close End Sub

A adapter

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub Test()
Dim Ws As Worksheet
Dim Chemin As String
 
Application.ScreenUpdating = False
Chemin = "C:\Documents and Settings\Administrateur\Bureau\"    'A adapter (anti slash en fin)
For Each Ws In ThisWorkbook.Worksheets
    Ws.Copy
    With ActiveWorkbook
        With .Worksheets(1).UsedRange
            .Value = .Value
        End With
        Application.DisplayAlerts = False
        .SaveAs Filename:=Chemin & Ws.Name, FileFormat:=xlOpenXMLWorkbook
        Application.DisplayAlerts = True
        .Close
    End With
Next Ws
End Sub

22/02/2012, 11h25
fhtazman
pour le chemin, une solution auto adaptée:
Code:

1 2 Chemin = ThisWorkbook.Path & "\"
Ainsi il reprend le chemin du classeur où est la macro.

Voir même si tu veux mettre les resultats dans un sous dossier:
Code:

1 2 3 4 5 6 Chemin = ThisWorkbook.Path & "\Resultats\" If Dir(Chemin , vbDirectory) = "" Then MkDir Chemin End If
si le chemin n'existe pas il est automatiquement créé! ;)

Bonjour,

Si tu veux transmettre un fichier, il faut le compresser au préalable avec WinRar ou WinZip, de préférence au format zip. Essaie la macro suivante :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub CreerFichiers()
    Dim Sh As Worksheet, Chemin As String
    Chemin = "D:\Documents and Settings\user\My Documents\Report\"
    For Each Sh In Worksheets
        If IsNumeric(Application.Match(Sh.Name, ['liste onglets'!A:A], 0)) Then
            Sh.Copy
            Sh.Cells.Copy
            ActiveSheet.[A1].PasteSpecial xlPasteValues
            ActiveWorkbook.SaveAs Chemin & Sh.Name, xlOpenXMLWorkbook
            ActiveWorkbook.Close False
        End If
    Next Sh
End Sub

22/02/2012, 13h47
Edou_ard

Bonjour,
merci à vous tous pour vos réponses.

@ mercatog: c'est exactement ce qu'il me fallait. Seul petit hic, j'ai du supprimer la ligne 11: ' .Value = .Value' car elle générait un bug
Je ne sais pas si c'est lié mais du coup, le collage ne se fait pas en valeur. Sais-tu comment faire?

@ fhtazman: j'ai intégré le code et cela fonctionne parfaitement.

@ Daniel.C: je n'ai pas l'utilité pour ce fichier de zipper les fichiers générés mais je garde ca sous le coude car j'en aurais probablement besoin pour d'autres fichiers.

Encore merci,
Edouard

Le code précédent a été testé. Et suite à ta remarque, j'ai ouvert ton fichier qui en faite comportait des TCD.
J'avais testé le code précédent et il fonctionnait sauf que les TCD restent liés au fichier d'origine.

Pourtant, j'ai une question si tu as des cellules fusionnées sur ton fichier réel?

Sinon, je te propose une autre variante (un peu différente): Au lieu de copier chaque feuille, y figer les données et l'enregistrer comme un nouveau classeur, le nouveau code crée un nouveau classeur pour chaque feuille et y colle les données puis l'enregistre.
Testé sur ton fichier
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 Sub Test() Dim Ws As Worksheet Dim Chemin As String Application.ScreenUpdating = False Chemin = "C:\Users\user\Desktop\" 'A adapter (anti slash en fin) For Each Ws In ThisWorkbook.Worksheets If Val(Ws.Name) > 0 Then With Workbooks.Add(1) Ws.UsedRange.Copy With .Worksheets(1) With .Range("A1") .PasteSpecial Paste:=xlPasteValuesAndNumberFormats .PasteSpecial Paste:=xlPasteFormats .PasteSpecial Paste:=xlPasteColumnWidths End With .Name = Ws.Name End With Application.CutCopyMode = False Application.DisplayAlerts = False .SaveAs Filename:=Chemin & Ws.Name, FileFormat:=xlOpenXMLWorkbook Application.DisplayAlerts = True .Close End With End If Next Ws End Sub

23/02/2012, 17h10
Daniel.C

Citation:

@ Daniel.C: je n'ai pas l'utilité pour ce fichier de zipper les fichiers générés mais je garde ca sous le coude car j'en aurais probablement besoin pour d'autres fichiers.

Tu m'as mal compris, le code ne compresse pas les fichiers. Je te disais seulement, pour mettre un fichier xlsm en pièce jointe de le compresser au préalable.
27/02/2012, 17h18
Edou_ard

Ok Merci.
Personne n'a la solution concernant le copier collage de la feuille contenant le TCD?