Déplacer toutes les feuilles après la 2ème dans un nouveau classeur

[philippe_chalon01]

Bonjour tout le monde,
J'aimerais pouvoir, avec une macro et un bouton, déplacer plusieurs feuilles (toutes les feuilles située après la 2ème feuille du classeur nommée "Rapport") dans un nouveau classeur portant le nom de la cellule "P5" de la feuille "Saisie"
J'ai utilisé le code suivant mais il y a un problème au niveau : Sheets(Sheets(i)).Move Before:=Workbooks(NomFichier & ".xls").Sheets(1)


Sub Deplacer()

Dim NbFeuilles, i As Integer
Dim NomFichier As String

NbFeuilles = Sheets.Count
i = 0

NomFichier = Sheets("Saisie").Range("P5").Value
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=NomFichier

Workbooks("Rapport 2 empreintes - copie").Activate

For i = NbFeuilles To 2 Step -1
Sheets(Sheets(i)).Move Before:=Workbooks(NomFichier & ".xls").Sheets(1)
Workbooks("Rapport 2 empreintes - copie.xls").Activate
Next i

Workbooks("Rapport 2 empreintes - copie.xls").Activate

End Sub




Merci à ceux qui prendront le temps de m'aider


Edit : Ci-joint à fichier si ça peut aider certains à comprendre

 

[Alza]

Bonjour,
Sheets(i) est un objet il ne te renvoie pas le nom de la feuille, utilise Sheets(i).name.

 

[philippe_chalon01]

Bonjour,
Oui pardon il y était initialement mais je l'avais enlevé pour voir si ça allait marcher sans. Et même avec il ne marche pas.

 

[Efgé]

Bonjour

Juste une question:
Workbooks("Rapport 2 empreintes - copie") est le vrai nom de ton classeur de base ?
On pourrait utiliser dans ton exemple "Fichier essai" ?

Cordialement

 

[philippe_chalon01]

Bonjour,
Oui c'était le nom original mais c'est vrai que du coup j'ai modifié le nom du fichier sans modifier les codes dans les macros, désolé.

 

[Yurperqod]

Bonjour le forum

Une possibilité (sans gestion d'erreur - cellule P5 vide ou nom fichier invalide)

Sub test()
Dim Chemin As String, NomFichier As String, NouvClass As Workbook
Chemin = ThisWorkbook.Path & "\"
NomFichier = Sheets("Saisie").Range("P5").Text
Sheets(Array("123-1", "123-2", "123-3")).Copy
Set NouvClass = ActiveWorkbook
NouvClass.SaveAs Chemin & NomFichier & ".xlsx", 51
NouvClass.Close True
End Sub

 

[Efgé]

Re à tous
Comme Yurperqod en pas pareil

(sans gestion d'erreur - cellule P5 vide ou nom fichier invalide)

Sub Test()
Dim Tableau As Variant, nom$, i&
With ThisWorkbook
  'remplacer le ThisWorkbook.Path par le chemin du dossier nécessaire...
  nom = ThisWorkbook.Path & "\" & .Sheets("Saisie").Range("P5").Value & ".xls"
  For i = 2 To ThisWorkbook.Worksheets.Count '2 si l'on prend la feuille 2 sinon a adapter
  If Not IsArray(Tableau) Then
  Tableau = Array(.Worksheets(i).Name)
  Else
  ReDim Preserve Tableau(UBound(Tableau) + 1)
  Tableau(UBound(Tableau)) = .Worksheets(i).Name
  End If
  Next i
End With
If IsArray(Tableau) Then
  Worksheets(Tableau).Move
  ActiveWorkbook.SaveAs Filename:=nom
End If
End Sub

Cordialement

 

[philippe_chalon01]

Bonjour Yuperqod,
Merci de ton aide,
Cependant le problème est que le nom des feuilles vont être aléatoires, ce ne sera jamais les même. Il faut donc une macro qui puisse aller chercher les feuilles situées après celle "rapport" , ou tout simplement les feuilles situées après la 2ème

 

[philippe_chalon01]

Merci beaucoup Efgé, ça marche parfaitement !
Bonne fin de journée à tous,
Philippe.

 

[Yurperqod]

Suite

Pour tenir compte du nombre de feuille variable, la même macro que tout à l'heure mais modifiée en conséquence.

Sub testB()
Dim Chemin As String, NomFichier As String, NouvClass As Workbook
Workbooks.Add (1): Set NouvClass = ActiveWorkbook: ThisWorkbook.Activate
Chemin = ThisWorkbook.Path & "\"
NomFichier = ThisWorkbook.Sheets("Saisie").Range("P5").Text
Sheets.Select: Sheets.Copy After:=NouvClass.Sheets(1)
Application.DisplayAlerts = False
Sheets(Array("Feuil1", "Saisie", "Rapport")).Delete
NouvClass.SaveAs Chemin & NomFichier & ".xlsx", 51: NouvClass.Close True
End Sub

 

[Efgé]

Re bonjour à tous

Sheets(Array("Feuil1", "Saisie", "Rapport")).Delete

Le problème est qu'il faut deviner/récupérer le nom des feuilles et non les écrire en "dur" dans le code; d'où ma proposition en s'appuyant sur leurs index.

Mais sinon, l'idée d'enregistrer tout le classeur et supprimer les feuilles est très bonne...


Cordialement

 

[Yurperqod]

Bonjour Efgé

Re bonjour à tous
Le problème est qu'il faut deviner/récupérer le nom des feuilles et non les écrire en "dur" dans le code; d'où ma proposition en s'appuyant sur leurs index.
Mais sinon, l'idée d'enregistrer tout le classeur et supprimer les feuilles est très bonne...
Cordialement

Normalement les noms des feuilles à supprimer est connu: Feuil1, Saisie, Rapport.
Et le Sheets.Select sélectionne toutes les feuilles.
Au final, le résultat est le même (mais ton code est plus sécure )
Philippe n'a plus que l'embarras du choix.
(Il reste à ajouter la gestion du contenu de la cellule P5 pour avoir un nom de fichier valide)

 

[Efgé]

Normalement les noms des feuilles à supprimer est connu: Feuil1, Saisie, Rapport.

Oui, tant qu'on est dans un Excel Français..... "Feuil1" ne sera reconnu dans aucune autre version, nous avons des "Sheet1", "Hoja1", j'en passe et des meilleures

Mais les deux solutions sont bonnes

Cordialement

 

[Yurperqod]

Suite bis

•>Efgé
En tenant compte de ta dernière remarque

Sub testC()
Dim Chemin As String, NomFichier As String, NouvClass As Workbook
Workbooks.Add (1): Set NouvClass = ActiveWorkbook: ThisWorkbook.Activate
Chemin = ThisWorkbook.Path & "\"
NomFichier = ThisWorkbook.Sheets("Saisie").Range("P5").Text
Sheets.Select: Sheets.Copy After:=NouvClass.Sheets(1)
Application.DisplayAlerts = False
Sheets(Array(1, 2, 3)).Delete
NouvClass.SaveAs Chemin & NomFichier & ".xlsx", 51: NouvClass.Close True
End Sub