Discussion :

[jeannevds]

Bonjour à tous,

J'ai un classeur composé de plusieurs onglets (entre 3 et i) créés en amont grâce à différentes macros.
Je cherche un moyen d'enregistrer tous les onglets à partir du 3ème sur un nouveau classeur Excel, sachant que le nombre d'onglets à enregistrer est inconnu.

Merci d'avance !

Jeanne

[Pierre Fauconnier]

Salut.

En considérant que les feuilles à copier sont dans l'ordre dans lequel elles apparaissent à l'écran:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Sub CopySheets()
  Dim Counter As Long
 
  If Worksheets.Count >= 3 Then
    ReDim ws(3 To Worksheets.Count)
    For Counter = 3 To Worksheets.Count
      ws(Counter) = Worksheets(Counter).Name
    Next
    Worksheets(ws).Copy
  End If
End Sub

[joe.levrai]

Bonjour,

plutôt que de "tout copier sauf 2 feuilles", pourquoi ne pas supprimer les deux premières feuilles et faire un SaveCopyAs ?

[jeannevds]

Bonjour,

plutôt que de "tout copier sauf 2 feuilles", pourquoi ne pas supprimer les deux premières feuilles et faire un SaveCopyAs ?

Bonjour,

Il est vrai que j'aurais pu supprimer les 2 premières pages mais je préfère exporter les pages cibles plutôt que de toucher au fichier de base

Merci quand même pour cette proposition

Bonne fin de journée

[patricktoulon]

bonjour pierre

Code :

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

1
2
3
4
5
6
7
Sub test()
Dim tabl(), sh, x
For Each sh In Worksheets
If sh.Index > 3 Then x = x + 1: ReDim Preserve tabl(1 To x): tabl(x) = sh.Name
Next
Sheets(tabl).Copy
End Sub

[jeannevds]

Salut.[...]

ça marche très bien ! Merci beaucoup !

J'ai adapté votre code afin d'enregistrer directement le fichier au bon endroit et sous un bon nom :

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
Sub EnregistrementRapport()
 
    Dim Counter As Long
 
    If Worksheets.Count >= 3 Then
        ReDim ws(3 To Worksheets.Count)
        For Counter = 3 To Worksheets.Count
            ws(Counter) = Worksheets(Counter).Name
        Next
 
        Filtre = "Fichier Excel(*.xlsx),*.xlsx"
        Titre = "Enregistrer le fichier sous"
        Chemin = Application.GetSaveAsFilename(, Filtre, , Titre)
 
        Worksheets(ws).Copy
        ActiveWorkbook.SaveAs Filename:=Chemin
 
        On Error Resume Next
        ActiveWindow.Close
    End If
 
End Sub

Encore merci, bonne fin de journée

[Pierre Fauconnier]

Alors, tant qu'à faire, histoire d'éviter de devoir fermer la fenêtre

Code :

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

1
2
        Worksheets(ws).Copy
        activeworkbook.Close savechanges:=true, Filename:=Chemin

[jeannevds]

Alors, tant qu'à faire, histoire d'éviter de devoir fermer la fenêtre

Code :

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

1
2
        Worksheets(ws).Copy
        activeworkbook.Close savechanges:=true, Filename:=Chemin

Encore mieux !

Merci