[XL-2003] Création d'une nouvelle feuille pour une liste de fichier [Résolu]

[Cedrick]

Bonjour,

Voici mon problème :

Je voudrais rajouter une feuille dans plusieurs classeur à la suite. J'ai bien réussi à ouvrir les classeurs, mais les feuilles sont crées dans le fichier du lancement de la macro.

Voici le code :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub Workbook_Open()
Dim LstFich, xfile
Application.ScreenUpdating = False
'Ouverture des fichiers
LstFich = Application.GetOpenFilename("Fichiers Excel(*.xls),*.xls", , _
"Sélection des fichiers à convertir", , True) 'true pour une selection multiple
 
If Not IsArray(LstFich) Then Exit Sub
 
For Each xfile In LstFich
 
    Workbooks.Open FileName:=xfile
    On Error Resume Next
    Workbooks(xfile).Activate
    Sheets.Add
    On Error GoTo 0
    ActiveWorkbook.Save
    ActiveWorkbook.Close
 
Next xfile
 
ActiveWorkbook.Close
End Sub

Si quelqu'un a une solution à me proposer je suis preneur.

Merci.

[Antoun]

en utilisant ActiveWorkbook.Sheets.Add plutôt que Sheets.Add tout court ?

[fgiambelluco]

Bonjour
A la place de :

Code :

1
2
3
4
    Workbooks(xfile).Activate
    Sheets.Add
    ActiveWorkbook.Save
    ActiveWorkbook.Close

Essaye :

Code :

1
2
    Workbooks(xfile).Sheets.Add
      Workbooks(xfile).Close , True

[aalex_38]

Une solution pour maitriser ce que l'on fait est d'instancier :

Code :

1
2
3
4
5
6
7
8
Dim wb As Workbook
Dim F1 As Worksheet
 
Set wb = Workbooks.Open(Filename:=xfile)
Set F1 = wb.Worksheets.Add
With F1
    .Name = "LanouvelleFeuille"
End With

Finalement en reprenant ton code ça donne ceci :

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
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Dim wb As Workbook
Dim F1 As Worksheet
Dim LstFich, xfile
 
Application.ScreenUpdating = False
'-------------------------------------'
'Ouverture des fichiers
'-------------------------------------'
LstFich = Application.GetOpenFilename("Fichiers Excel(*.xls),*.xls", , _
"Sélection des fichiers à convertir", , True) 'true pour une selection multiple
 
If Not IsArray(LstFich) Then Exit Sub
 
For Each xfile In LstFich
 
    Set wb = Workbooks.Open(Filename:=xfile)
    '-----------------------'
    ' Ajout d'une feuille
    '-----------------------'
    Set F1 = wb.Worksheets.Add
    With F1
     .Name = "LanouvelleFeuille"
    End With
 
    '-------------------------------------'
    ' Sauvegarde et fermeture du classeur
    '-------------------------------------'
    With wb
        .Save
        .Close
    End With
 
 
Next xfile
 
'-----------------------------------------------'
' Fermeture du classeur ou se trouve cette macro
'-----------------------------------------------'
ThisWorkbook.Close
 
Application.ScreenUpdating = True ' il parait que c pas ncr mais je le met tjrs
End Sub

[Cedrick]

Merci c'est impécable !

Ca fonctionne à merveille

Merci pour les conseils et la solution !

[aalex_38]

Une dernière chose que j'ai oublié dans le code, liberer les objets.

Fin du code :

Code :

1
2
3
4
5
6
7
8
9
'-----------------------------------------------'
' On libère les objets
'-----------------------------------------------'
Set F1 = Nothing
Set wb = Nothing
'-----------------------------------------------'
' Fermeture du classeur ou se trouve cette macro
'-----------------------------------------------'
ThisWorkbook.Close

Ca fonctionne à merveille

Je trouve aussi, le code est intéressant