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