Comment déplacer plusieurs feuilles sélectionnées dans un autre classeur

Gecko62

XLDnaute Nouveau
Bonjour,

Je dois déplacer plusieurs feuilles d'un classeur dans un autre et cela par macro

J'arrive à sélectionner les feuilles à déplacer, mais une fois que celles-ci sont sélectionnées, je n'arrive pas à les déplacer

Voici ma macro :
Code:
Sub CreeFichier()
'
' Définition des variables utilisées

  Dim NbFeuilles, i As Integer
  Dim NomFichier As String
  Dim TableDesFeuilles() As String
  Dim S As Worksheet
  Dim X As Byte
  Dim WB1 As Workbook


' Début de la macro
  ' Je recherche le nombre totale du classeur
    NbFeuilles = Sheets.Count
    i = 0
  ' Défini le nom du nouveau fichier en fonction du camp
    NomFichier = Sheets("Données de base").Range("F25").Value
  ' Crée le fichier
    Workbooks.Add
  ' Sauve le classeur sous nouveau nom
    ActiveWorkbook.SaveAs Filename:=NomFichier
  '  MsgBox ("PretMateriel.xls"), vbOKOnly, "Nom du classeur"
    
    Workbooks("PretMateriel.xls").Activate

  ' Sélectionne toutes les feuilles à déplacer du fichier
    For i = 3 To NbFeuilles
    ReDim Preserve TableDesFeuilles(X)
    TableDesFeuilles(X) = Sheets(i).Name
        X = X + 1
    Next
    Workbooks("PretMateriel.xls").Sheets(TableDesFeuilles).Select

' Les feuilles à déplacer sont bien sélectionnées
' et c'est là que le bas blesse ...
  
  ' Déplace toutes les feuilles dans le classeur créé
    Sheets(Array(TableDesFeuilles)).Move _
        Before:=Workbooks(NomFichier).Sheets(1)
'
' ou
'
    Workbooks("PretMateriel.xls").Sheets(TableDesFeuilles).Move _
        Before:=Workbooks(NomFichier).Sheets(1)

' les deux solutions renvoient une erreur

End Sub
Par avance un grand merci pour votre aide

Gecko62
 

BrunoM45

XLDnaute Barbatruc
Re : Comment déplacer plusieurs feuilles sélectionnées dans un autre classeur

Bonjour Gecko62 et bienvenue sur ce forum

Si je puis me permettre tu t'y prends mal ;)
Tu déplaces d'abord tes feuilles dans un nouveau classeur, puis ut enregistres celui-ci
VB:
Sub CreeFichier()
'
' Définition des variables utilisées
  Dim NbFeuilles, i As Integer
  Dim NomFichier As String
  Dim TableDesFeuilles() As String
  Dim X As Byte
  ' Début de la macro
  ' Je recherche le nombre totale du classeur
  NbFeuilles = Sheets.Count
  i = 0
  ' Défini le nom du nouveau fichier en fonction du camp
  NomFichier = Sheets("Données de base").Range("F25").Value
'  Sélectionne toutes les feuilles à déplacer du fichier
  For i = 3 To NbFeuilles
      ReDim Preserve TableDesFeuilles(X)
      TableDesFeuilles(X) = Sheets(i).Name
      X = X + 1
  Next
  Workbooks("PretMateriel.xls").Sheets(TableDesFeuilles).Select
  ' Les feuilles à déplacer sont bien sélectionnées
  ' Déplace toutes les feuilles dans le classeur créé
  Sheets(Array(TableDesFeuilles)).Move
  
  ' Sauve le classeur sous nouveau nom
  ActiveWorkbook.SaveAs Filename:=NomFichier
  '  MsgBox ("PretMateriel.xls"), vbOKOnly, "Nom du classeur"
End Sub
A+
 

Gecko62

XLDnaute Nouveau
Re : Comment déplacer plusieurs feuilles sélectionnées dans un autre classeur

Bonjour BrunoM45,

Un grand merci pour cette solution, mais une autre possibilité m'a été proposée qui convient à ma démarche

Code:
Sub CreeFichier()
'
'
  Dim NbFeuilles, i As Integer
  Dim NomFichier As String
'  Ces deux variables ne sont plus nécessaires
'  Dim TableDesFeuilles() As String
'  Dim X As Byte
'
'
' Début de la Macro
  ' Je recherche le nombre de feuilles total du classeur
    NbFeuilles = Sheets.Count
    i = 0
  ' Je défini le nom du fichier en fonction du camp
    NomFichier = Sheets("Données de base").Range("F25").Value
  ' Je crée le fichier
    Workbooks.Add
  ' Je sauve le classeur sous nouveau nom
    ActiveWorkbook.SaveAs Filename:=NomFichier
  ' Je rends le focus sur le fichier de départ
    Workbooks("PretMateriel.xls").Activate
  
  ' Je sélectionne toutes les feuilles du fichier (opération désormais inutile)
  '  For i = 3 To NbFeuilles
  '  ReDim Preserve TableDesFeuilles(X)
  '  TableDesFeuilles(X) = Sheets(i).Name
  '      X = X + 1
  '  Next
  '  Workbooks("PretMateriel.xls").Sheets(TableDesFeuilles).Select
  
  ' Je déplace toutes les feuilles du camp (de la 3ème à la dernière)
  ' dans le classeur créé par une boucle
     For i = 3 To NbFeuilles
        Sheets(Sheets(3).Name).Move Before:=Workbooks(NomFichier & ".xls").Sheets(1)
        Workbooks("PretMateriel.xls").Activate
     Next i

  ' Je rends le focus au fichier de base
    Workbooks("PretMateriel.xls").Activate
  ' Je sauve et ferme le fichier créé pour le camp
    Workbooks(NomFichier & ".xls").Save
    Workbooks(NomFichier & ".xls").Close

End Sub
Il y a toujours plusieurs chemins pour aboutir au résultat escompté seul la réflexion et l'entraide permettent de l'atteindre.

Une fois encore un grand merci

Gecko62
sous Windows XP et Excel 2003
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas