Discussion :

[abdou57]

Bonsoir,
j'ai un classeur qui contient 377 feuilles, il devient très lent à la fermeture avec sauvegarde. je veux l'éclater en créant un classeur par onglet. chaque nouveau classeur aura le même nom que la feuille qu'il contiendra.

j'ai fais cette macro mais elle ne marche pas.

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
 
Sub create_feuille_par_classeur()
    Dim xlApp As New Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlBook1 As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim strPath As String
 
    strPath = ThisWorkbook.Path
    Set xlBook1 = ThisWorkbook
    Set xlBook = xlApp.Workbooks.Add
 
    For Each xlSheet In xlBook1.Sheets
        xlSheet.Copy
        xlBook.Sheets(1).Name = xlSheet.Name
        xlBook.Sheets(1).Paste
        xlBook.SaveAs strPath & "\" & xlSheet.Name
    Next xlSheet
 
    Set xlBook = Nothing
    Set xlSheet = Nothing
    Set xlBook1 = Nothing
    xlApp.Quit
End Sub

merci pour votre aide

[kiki29]

Salut,voir l'excellent travail de pgz sur http://www.developpez.net/forums/d10...paree-onglets/ qui moyennant peu d'adaptation devrait te convenir

[mercatog]

Bonsoir
Pas la peine de créer une autre instance d'excel
une proposition:

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 Create_Feuille_Par_Classeur()
Dim Sh As Worksheet
Dim strPath As String
 
Application.ScreenUpdating = False
strPath = ThisWorkbook.Path
For Each Sh In ThisWorkbook.Worksheets
    Sh.Copy
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs strPath & "\" & Sh.Name & ".xls"
    Application.DisplayAlerts = True
    ActiveWorkbook.Close
Next Sh
End Sub

[abdou57]

Bonsoir,
merci kiki29 et mercatog pour vos réponses et pour le temps que vous avez consacré à ma question. la solution de mercatog répond exactement à ce que je veux, je l'ai adopté telle quelle.