Déplacer plusieurs feuilles sélectionnées par
Résolu
Gecko62
Messages postés
4
Statut
Membre
-
Le Pingou Messages postés 12274 Date d'inscription Statut Contributeur Dernière intervention -
Le Pingou Messages postés 12274 Date d'inscription Statut Contributeur Dernière intervention -
Bonjour,
J'aimerais déplacer plusieurs feuilles sélectionnées par macro dans un nouveau classeur mais la macro que j'ai écrite ne fonctionne pas.
La macro fonctionne jusqu'au 4 dernière ligne et après se plante sans que je ne comprenne pourquoi !
Merci de votre aide
J'aimerais déplacer plusieurs feuilles sélectionnées par macro dans un nouveau classeur mais la macro que j'ai écrite ne fonctionne pas.
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
La macro fonctionne jusqu'au 4 dernière ligne et après se plante sans que je ne comprenne pourquoi !
Merci de votre aide
4 réponses
-
Bonjour,
Est-il possible d'avoir le message d'erreur et son code? -
Bonjour,
En principe dans votre boucle comme suit :For i = 3 To NbFeuilles Sheets(Sheets(i).Name).Move Before:=Workbooks("nom classeur cible.xlsx").Sheets(1) Next i -
Merci le Pingu,
ta solution m'a mis sur la piste et moyennant un petit ajustement cela fonctionne correctement. J'ai rajouté une variable contenant le numéro de feuille à déplacer, car dans le cas contraire la macro voulait copier une feuille qui n'existait plus! Voici donc le code final de la boucle
' Déplace toutes les feuilles de la 3ème à la dernière dans le classeur créé For i = 3 To NbFeuilles Sheets(Sheets(z).Name).Move Before:=Workbooks(NomFichier & ".xls").Sheets(1) Workbooks("PretMateriel.xls").Activate Next i
Une fois encore un très grand merci -
Bonjour,
Merci pour l'information.
Eh oui cela m'a échappé, il fallait simplement la boucle avec le décompte depuis la fin :For i = NbFeuilles To 3 Step -1
