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

[Gecko62]

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 :

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

 

[Compte Supprimé 979]

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

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]

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

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