Deplacement 4 onglets dans autre classeur

Bonjour tous le monde,

Je viens vers vous car je me complique la tete sur un truc tout bête et pourtant je lutte.

Voici mon classeur en pièce jointe.

Je souhaite intégrer une macro à mon bouton, pour que quand je clique dessus, ca m'enregistre uniquement les 5 onglets dans un classeur prenant en charge les macros qui se nommerais situation facturation.

Si possible il faudrait qu'il s'enregistre sur mon bureau.

Merci de votre aide

Bonjour

question idiote, mais bon...

tu veux seulement exporter les onglets et enregistrer le fichier au format xlsm,

ou tu veux faire une copie de ce fichier (qui contiendra des macros) en supprimant d'autres onglets ???

fred

EDIT :

ci joint une proposition :

si c'est pour la premiere possibilité :

Sheets(Array(1, 2, 3, 4, 5)).Copy
 ActiveWorkbook.SaveAs "C:\Users\Fred\Desktop\situation facturation.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
 ActiveWorkbook.Close False

si c'est pour la deuxième possibilité, il suffit de l'ouvrir ensuite et de supprimer les onglets qui ne te plaisent pas

ActiveWorkbook.SaveCopyAs "C:\Users\Fred\Desktop\situation facturation.xlsm"

Bonsoir,

Ci-joint une proposition, à tester (sur la base de la 2ème possibilité mentionnée par Fred).

Bonne soirée

Bouben

Salut,

Merci pour vos réponse, Fred et Bouben,

La version de Bouben est parfaite suite aux conseils de Fred.

Cependant que dois-je changer dans le code pour que la page accueil soit aussi exporter.

A savoir que sur mon classeur originale, j'ai 20 onglets. et il y a que ces 5 là qui doivent etre recopier.

Option Explicit

Public Sub Exporter()

   Dim sChemin As String
   Dim oWB As Workbook

   sChemin = Environ("USERPROFILE") & "\Desktop\"
   sChemin = sChemin & "Situation facturation.xlsm"

   ThisWorkbook.SaveCopyAs sChemin

   Set oWB = Workbooks.Open(sChemin)
   'suppression de l'onglet "Accueil"
   Application.DisplayAlerts = False
   oWB.Worksheets("Accueil").Delete
   Application.DisplayAlerts = True
   oWB.Save
   oWB.Close
   Set oWB = Nothing

   MsgBox "Fichier exporté !", vbExclamation

End Sub

Re

comme tu n'as pas répondu a ma question

la seule proposition que je peux te faire c'est remplacer cette ligne

   oWB.Worksheets("Accueil").Delete

par les autres feuilles a supprimer

fred

BOnjour tous le monde,

VOici le classeur en pièce jointe avec des onglets rajoutés.

Lorsque je clique sur exporter, je veux que les 5 1eres feuils soit déplacées et enregistrées dans un classeur excel prenant en charge les macro sur mon bureau.

Ta solution est superbe, sauf que ca me copie toutes mes feuils.

Bonjour,

Ci-joint une nouvelle version, à tester.

Ne conserve que les 5 premiers onglets.

Remarque : l'onglet "Accueil" est conservé, donc avec lui, le bouton d'export. Par contre, le bouton d'export sur un fichier exporté ne fonctionnera pas : le fichier serait exporté à l'endroit où il est déjà.

Bonne journée

Bouben

Merci bouben,

dans ta derniere version, quand je copie ta macro sur mon fichier originale ou j'ai + de 20 onglets, lorsque je clique sur exporter ca me check toutes mes feuils, et me genere une erreur.

Du coup comme les macros ne seront pas utilisable sur le classeur copier sur le bureau, peut tu me changer ta macro, et ne pas exporter la feuill accueil.

Juste les 4 onglets de situation.

Merci

Bonjour,

Ci-joint une nouvelle version, sans export de l'onglet Accueil. A tester !

Bouben

bonjour

pouns tu dis :

Du coup comme les macros ne seront pas utilisable sur le classeur copier sur le bureau, peut tu me changer ta macro, et ne pas exporter la feuill accueil.

donc quel est l’intérêt de sauvegarder au format xlsm ???

et on en revient a faire ce que j'avais proposé a ma première reponse .... :

Sheets(Array( 2, 3, 4, 5)).Copy
 ActiveWorkbook.SaveAs "C:\Users\Fred\Desktop\situation facturation.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
 ActiveWorkbook.Close False

avec l'amélioration de Bouben

Sheets(Array( 2, 3, 4, 5)).Copy
 ActiveWorkbook.SaveAs Environ("USERPROFILE") & "\Desktop\situation facturation.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
 ActiveWorkbook.Close False

fred

Allez avec un petit plus...

exporter aussi la feuille accueil et supprimer le bouton qui fait l'export....

Sheets(Array(1, 2, 3, 4, 5)).Copy
Sheets(1).Shapes("Rectangle 1").Delete
ActiveWorkbook.SaveAs Environ("USERPROFILE") & "\Desktop\situation facturation.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
ActiveWorkbook.Close False

fred

Merci pour vos réponses !!

Cependant lorsque je vais sur mon classeur perso, je met le meme macro dans un rectangle !!

Quand je clique sur exporter, ca m'exporte toutes les feuilles et ca me genere des erreurs !!

A savoir que mon classeur perso et le classeur test de ce post n'est pas identique.

Seul le nom des feuils sont identique, mais sur mon perso, j'en ai beaucoup plus.

re

pour info :

Sheets(Array(1, 2, 3, 4, 5)).Copy

c'est la position des feuilles dans le classeur....

donc les 5 premiers onglets sont exportés... si cela ne correspond pas soit modifier ces numéros soit mettre les noms des onglets

pour supprimer le rectangle s'assurer qu'il porte bien ce nom "rectangle 1"

soit dans le ruban mise en page/volet selection/

fred

Bonsoir tous le monde, bonsoir Fred,

Merci pour ta réponse,

Du coup j'utilise le code suivant :

Sheets(Array(23, 24, 25, 26)).Copy
Sheets(1).Shapes("Rectangle 1").Delete
ActiveWorkbook.SaveAs "\Desktop\situation facturation.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
ActiveWorkbook.Close False

sur mon classeur perso, j'ai deux rectangle sur chaque onglets. un qui se nomme rectangle1 et l'autre rectangle2. comment puis je inserer ceci dans le code?

Merciiiii

ce code fonctionne nickel, par contre il existe peut etre plus court non? genre Rectangle 1; Rectangle 2) ou bien all rectangle? lol

Sheets(Array(23, 24, 25, 26)).Copy
Sheets(1).Shapes("Rectangle 1").Delete
Sheets(1).Shapes("Rectangle 2").Delete
Sheets(2).Shapes("Rectangle 1").Delete
Sheets(2).Shapes("Rectangle 2").Delete
Sheets(3).Shapes("Rectangle 1").Delete
Sheets(3).Shapes("Rectangle 2").Delete
Sheets4).Shapes("Rectangle 1").Delete
Sheets(4).Shapes("Rectangle 2").Delete
ActiveWorkbook.SaveAs "\Desktop\situation facturation.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
ActiveWorkbook.Close False

bonsoir

svp envoyer le code complet

Option Explicit

Public Sub Exporter()
Sheets(Array(22, 23, 24, 25)).Copy
Sheets(1).Shapes("Rectangle1").Delete
Sheets(1).Shapes("Rectangle2").Delete
Sheets(2).Shapes("Rectangle1").Delete
Sheets(2).Shapes("Rectangle2").Delete
Sheets(3).Shapes("Rectangle1").Delete
Sheets(3).Shapes("Rectangle2").Delete
Sheets(4).Shapes("Rectangle1").Delete
Sheets(4).Shapes("Rectangle2").Delete
 ActiveWorkbook.SaveAs "g:\situation facturation.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
 ActiveWorkbook.Close False

End Sub

Bonjour

Ci joint une autre proposition

fred

Public Sub Exporter()
Sheets(Array(22, 23, 24, 25)).Copy
For i& = 1 To 4
    Sheets(i).Shapes.Range(Array("rectangle 1", "rectangle 2")).Delete
Next
ActiveWorkbook.SaveAs "g:\situation facturation.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
ActiveWorkbook.Close False
End Sub