Discussion :

[Edou_ard]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[mercatog]

A adapter

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[fhtazman]

pour le chemin, une solution auto adaptée:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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éé!

[Daniel.C]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[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

[mercatog]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Daniel.C]

@ 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.

[Edou_ard]

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