Discussion :

[drthodt]

Bonjour à tous,
voici ma question pour laquelle je n'ai pour le moment aucune piste.

J'ai un classuer Excel dans un dossier; ce classeur a de multiples onglets portant tous un nom.
J'aimerai créer une macro qui en fait me créée un nouveau fichier Excel par onglet,contenant uniquement ce qui se trouve sur cet onglet (le fichier portera si possible le nom de l'onglet en question).
Comment faire ceci?
Merci d'avance pour vos réponses,
M

[neupont]

Salut,
Ce code-là devrait fonctionner :

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
 
Sub CopieOnglets()
 
Dim ceFichier As Workbook
Set ceFichier = ActiveWorkbook
 
Dim nouveauFichier As Workbook
 
For Each fSheet In ceFichier.Worksheets
    Workbooks.Add
    Set nouveauFichier = ActiveWorkbook
    fSheet.Copy Before:=nouveauFichier.Sheets(1)
Next
 
ceFichier.Activate
 
End Sub

[neupont]

J'ai oublié une partie de ta demande.
Si tu veux donner le nom de l'onglet au nouveau classeur, il faut l'enregistrer sur le disque dur (variable "chemin" à définir au préalable) :

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
 
Sub CopieOnglets()
 
Dim ceFichier As Workbook
Set ceFichier = ActiveWorkbook
 
Dim nouveauFichier As Workbook
 
For Each fSheet In ceFichier.Worksheets
    Workbooks.Add
    Set nouveauFichier = ActiveWorkbook
    fSheet.Copy Before:=nouveauFichier.Sheets(1)
    nouveauFichier.SaveAs Filename:=chemin & "\" & fSheet.Name, FileFormat:=xlNormal

Next
 
ceFichier.Activate
 
End Sub

[drthodt]

Grand merci à toi,
réponse rapide, simple et qui fonctionne parfaitement.
Bonne journée,
M.

[AlainTech]

Tu n'aurais pas oublié le bouton ?

[drthodt]

Bonjour,
@le modérateur: non je n'ai pas oublié le bouton résolu car en fait j'ai un message d'erreur qui apparaît (je n'ai pas eu le temps de poster ça hier).

Le message en question ("Excel a rencontré une erreur et a supprimé une partie de la mise en forme pour éviter d'endommager le classeur.Revérifiez soigneusement votre mise en forme."), avec capture d'écran en pièce jointe du message,merci d'avance si vous pouvez m'aider,
M

[ouskel'n'or]

Laisse le temps à Excel d'ajouter un classeur avant de copier la feuille

Code :

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

1
2
3
4
5
6
7
8
9
For Each fSheet In ceFichier.Worksheets
    Workbooks.Add
    DoEvents
    Set nouveauFichier = ActiveWorkbook
    fSheet.Copy Before:=nouveauFichier.Sheets(1)
    DoEvents
    nouveauFichier.SaveAs Filename:=chemin & "\" & fSheet.Name, FileFormat:=xlNormal
    DoEvents
Next

Faut que le système ait le temps de faire ses petites affaires
Regarde dans l'aide le rôle de DoEvents
A+

[drthodt]

Merci pour ta réponse,
en fait j'ai été inexact j'ai ce petit message d'erreur car j'ai rajouté une ligne de code pour pouvoir fermer automatiquement le classeur dès sa création (pas envie d'en fermer quarante de suite );quand je supprime cette ligne je n'ai plus l'erreur

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
Sub copieOngletsfinal()

Dim ceFichier As Workbook
Set ceFichier = ActiveWorkbook
 
Dim nouveauFichier As Workbook
 
For Each fSheet In ceFichier.Worksheets
    Workbooks.Add
    Set nouveauFichier = ActiveWorkbook
    fSheet.Copy Before:=nouveauFichier.Sheets(1)
    DoEvents
    nouveauFichier.SaveAs Filename:="C:\test" & "\" & fSheet.Name, FileFormat:=xlNormal
    DoEvents
    nouveauFichier.Close
    
Next
 
ceFichier.Activate

End Sub

Cela viendrait-il d'un problème de syntaxe?Je ne sais pas encore trop bien manier les objets, ça me ferme bien le fichier mais me donne cette erreur.
Merci pour vos réponses en tout cas,
M

[ouskel'n'or]

Simplifie-toi la vie

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 copieOngletsfinal()
Dim ceFichier As Workbook
Dim nouveauFichier As Workbook
 
Set ceFichier = ActiveWorkbook
 
For Each fSheet In ceFichier.Worksheets
    Set NouveauFichier = Workbooks.Add
    DoEvents
    fSheet.Copy Before:=nouveauFichier.Sheets(1)
    DoEvents
    nouveauFichier.SaveAs Filename:="C:\test" & "\" & fSheet.Name, FileFormat:=xlNormal
    DoEvents
    nouveauFichier.Close False   
Next

Teste au moins sans rien changer

[drthodt]

Merci pour ta réponse, mais je me suis mal exprimé:
quand je rajoute cette ligne

Code :

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

nouveauFichier.Close

ça me créée bien tous mes fichiers, puis les ferme.
Le message d'erreur dont je parle n'apparaît que quand j'ouvre les fichiers, et non pas pendant l'exécution de ma macro.

Si certains informations peuvent aider, je suis sous Windows 2000 et Excel 2002.
Merci d'avance pour votre aide,
M

Rebonjour,
peut-être est-ce du à la méthode utilisée pour fermer mes fichiers?

[Jean-Pierre49]

Bonjour

un petit DoEvents peut être

Code :

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

1
2
nouveauFichier.Close False
DoEvents

[drthodt]

Bonjour,
un peu de temps cette semaine je reviens sur ce sujet.
Désolé toujours même constat en fait le message d'erreur apparaît toujours.

Je précise car ça n'a peut-êre pas été clair: ce message d'erreur n'apparaît pas quand j'exécute la macro, mais il apparaît quand j'ouvre les fichiers qui sont créés par cette macro (sauf quand j'enlève la ligne qui les "close" et que je le fais moi-même ça n'arrive plus).
Merci d'avance pour votre aide.
Cordialement,
M

[tivro57]

Bonjour ! Super je viens de tomber sur ce code ça marche super. Par contre en changeant le type et mettant " Type:=xlTypePDF " ça ne fonctionne pas malheureusement.

Auriez-vous une idée de comment faire svp ? (je souhaiterai enregistré directement en pdf chaque onglet avec le nom de l'onglet)

Merci pour votre / vos réponses.

[Philippe Tulliez]

Bonjour,

Par contre en changeant le type et mettant " Type:=xlTypePDF " ça ne fonctionne pas malheureusement.

Pour exporter le contenu d'un classeur ou d'une feuille excel, il faut utiliser la méthode ExportAsFixedFormat

Dans tous les exemples ci-dessous

• l'exportation à lieu dans le même répertoire que le classeur actif
• le nom du fichier exporté est préfixé de la date inversée et d'un caractère espacé

Exportation du classeur actif en fichier pdf
Le nom du fichier est le préfixe + Bilan(Année courante)

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub T_1()
  Dim PathName As String
  Dim FileName As String
  Dim FullName As String
  Dim Sep As String
  Sep = Application.PathSeparator
  FileName = Format(Date, "yyyymmdd") & " Bilan " & Year(Date) & ".pdf"
  FullName = Path & Sep & FileName
  Debug.Print FullName
  With ActiveWorkbook
    PathName = .Path
    .ExportAsFixedFormat Type:=xlTypePDF, FileName:=FullName
  End With
End Sub

Exportation de la feuille active en fichier pdf
Le nom du fichier est le préfixe + le nom de la feuille active suivit du numéro de l'année active

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub T_2()
  Dim PathName As String
  Dim FileName As String
  Dim FullName As String
  Dim Sep As String
  Sep = Application.PathSeparator
  With ActiveSheet
    FileName = Format(Date, "yyyymmdd") & " " & .Name & " " & Year(Date) & ".pdf"
    PathName = .Parent.Path
    FullName = Path & Sep & FileName
    .ExportAsFixedFormat Type:=xlTypePDF, FileName:=FullName
  End With
End Sub

Exportation des feuilles nommées Contact et Db du classeur actif en deux fichiers pdf distincts
Le nom du fichier est le préfixe + le nom de la feuille source

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
Sub t3()
  Dim sht As Worksheet
  Dim PathName As String
  Dim FileName As String
  Dim FullName As String
  Dim Sep As String
  Sep = Application.PathSeparator
 
  For Each sht In ActiveWorkbook.Worksheets
    With sht
      Select Case LCase(.Name)
        Case "contact", "db"
             FileName = Format(Date, "yyyymmdd") & " " & .Name & ".pdf"
             PathName = .Parent.Path
             FullName = Path & Sep & FileName
             .ExportAsFixedFormat Type:=xlTypePDF, FileName:=FullName
      End Select
    End With
  Next
End Sub