Macro de Copie : onglet vers fichier

Bonjour à tous,

J'aurais besoin d'une petite aide pour une macro qui ne dois pas être très compliquée :p

J'ai un classeur xls qui est généré automatiquement via un logciel.

Ce classeur contient une quinzaine d'onglets.

J'ai donc écrit une macro me permettant de copier chaque onglet vers un fichier qui aura pour nom, le nom de l'onglet copié :

Sub SaveOnglet()
    Dim Feuille As Worksheet

    Application.ScreenUpdating = False
    For Each Feuille In ThisWorkbook.Worksheets
        Feuille.Copy
        ActiveWorkbook.Close savechanges:=True, Filename:=ThisWorkbook.Path & "\" & ActiveWorkbook.Worksheets(1).Name
    Next Feuille
    Application.ScreenUpdating = True
End Sub

Jusque là, tout va bien, et ça marche.

Je voudrai par contre que l'onglet copié soit ajouté au fichier si celui-ci existe déjà (au lieu de le remplacer actuellement.)

Merci d'avance !

Bonjour,

Essaie ainsi :

Sub SaveOnglet()
Dim Feuille As Worksheet
Dim LeNom As String
Dim Flag As Boolean
Application.ScreenUpdating = False
For Each Feuille In ThisWorkbook.Worksheets
    LeNom = ActiveWorkbook.Path & "\" & Feuille.Name & ".xls"
    Flag = FileExists(LeNom) 'Test si le fichier existe
    If Flag Then
        Workbooks.Open LeNom
        Feuille.Copy After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
        ActiveWorkbook.Close True
    Else
        Feuille.Copy
        ActiveWorkbook.Close savechanges:=True, Filename:=LeNom
    End If
Next Feuille
Application.ScreenUpdating = True
End Sub
Function FileExists(S As String) As Boolean
  FileExists = Dir(S) <> ""
End Function

Bonne journée

Bonjour,

Une idée ?

Sub SaveOnglet()
Dim Feuille As Worksheet
Dim NomFich As String
Dim Wk As Workbook

    Application.ScreenUpdating = False
    For Each Feuille In ThisWorkbook.Worksheets
        NomFich = ThisWorkbook.Path & "\" & Feuille.Name & ".xls"
        If Dir(NomFich) = "" Then 'n'existe pas
            Feuille.Copy
            ActiveWorkbook.Close savechanges:=True, Filename:=NomFich
        Else 'classeur existe
            Set Wk = Workbook(NomFich).Open
            Feuille.Copy Before:=Wk.Sheets(1) 'en premier
            Wk.Save
            Wk.Close
        End If
    Next Feuille
    Application.ScreenUpdating = True
End Sub

A+

Bonjour,

Merci pour vos réponses, ça fonctionne bien !