Copier plusieurs feuilles dans un nouveau classeur

[roro69]

Bonsoir
Voici ;je voudrais copier les feuille 10 à 18 d'un classeur vers un nouveau classeur donc voici le code que j'ai mis en place:

Sub CopieFeuilles()
Dim k%
For k = 10 To Sheets.Count
Sheets(k).Copy
Next k
End Sub

Mais lorsque je lance la macro celle ci me crée bien un nouveau classeur mais avec une seul feuille ; et une erreur apparait "l'indice n'appartient pas à la sélection"
Si quelqu'un avait la solution ce serait gentil.
Merci pour le temps consacré
Bonne soirée

 

[mapomme]

Re : Copier plusieurs feuilles dans un nouveau classeur

Bonsoir roro69,

Essayez ce code (le classeur doit avoir 10 feuilles au moins):

Sub CopieFeuilles()
Dim A(), i
  ReDim A(10 To Sheets.Count)
  For i = 10 To Sheets.Count: A(i) = i: Next i
  Sheets(A).Copy
End Sub

Edit: v2 -> modif. mineures -> pour copie soit de 10 à 18 (si possible) soit de 10 au nombre total de feuilles (si possible)

 

[roro69]

Re : Copier plusieurs feuilles dans un nouveau classeur

Bonjour
Merci beaucoup pour ta réponses c'est complet et c'est exactement ce que je voulais.
Je me permets de te poser juste une autre question y a t-il moyen de ne copier que les feuilles où la cellule A4 n'est pas vide.
Merci pour le temps consacré et l'aide apporté.

 

[mapomme]

Re : Copier plusieurs feuilles dans un nouveau classeur

Bonjour roro69,

juste une autre question y a t-il moyen de ne copier que les feuilles où la cellule A4 n'est pas vide

J'ai modifié ma méthode. J'ai créé une procédure CopieFeuilles(BorneInf As Integer, BorneSup As Integer) qui prend deux paramètres en entrée. CopieFeuilles va copier dans un nouveau classeur les feuilles d'index compris entre BorneInf et BorneSup et cela uniquement si la valeur de la cellule A4 des feuilles n'est pas vide.

Pour appeler CopieFeuilles, utilisez la syntaxe:
CopieFeuilles 10, 18 (copie des feuilles 10 à 18 si A4 différent de "")

Pour copier toutes les feuilles à partir de 10, donnez une valeur "grande" à BorneSup, ex: CopieFeuilles 10, 9999

Le code:

Sub test()
  CopieFeuilles 10, 18
End Sub

Sub CopieFeuilles(BorneInf As Integer, BorneSup As Integer)
Dim i As Long, A(), N As Integer

With ThisWorkbook
  If BorneInf < 1 Then BorneInf = 1
  If BorneSup > .Sheets.Count Then BorneSup = .Sheets.Count
  If BorneInf > BorneSup Then Exit Sub
  
  For i = BorneInf To BorneSup
    If .Sheets(i).Range("A4").Value <> "" Then
      N = N + 1
      ReDim Preserve A(1 To N)
      A(N) = i
    End If
  Next i
  If N > 0 Then .Sheets(A).Copy
End With
End Sub