XL 2010 Exporter seulement la feuille active (Modification)

[donadoni16]

Bonjour à tous,
dans le fichier ci-annexé j'ai un code permettant d'exporter le noms de feuilles choisi
je souhaite le rectifier pour exporter juste la feuille active et le nouveau classeur prendra le nom du classeur d'origine + le nom de l'onglet exporté

comme ceci :
le nom du classeur d'origine est Fiche et l'onglet exporté par exemple Mars-15
donc le nouveau classeur sera nommé Fiche Mars-15

Merci

 

[vgendron]

Bonjour,

voir ton code modifié ci dessous..
pas testé.. parce que je me dis qu'il n'y a pas tout..
tu dis; que ton code permet de choisir l'onglet à exporter.. mais je vois pas où

Option Explicit


Sub ExporterFiche()
Dim s As Object
Dim NomOnglet As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
NomOnglet = ActiveSheet.Name
ActiveSheet.Copy
With ActiveWorkbook
  For Each s In .Sheets: s.DrawingObjects.Delete: Next
  .SaveAs ThisWorkbook.Path & "\Fiche " & NomOnglet, 51
  .Close
End With
ActiveCell.Activate
End Sub

 

[donadoni16]

Bonjour vgendron
merci pour ta réponse mais le code beug sur : ActiveSheet.Copy

 

[vgendron]

J'ai édité mon post.. je ne sais pas si tu as pris le second code ?
avec celui actuel . chez moi. pas de bug..

 

[donadoni16]

re,
en appliquant ton code sur mon fichier d'origine j'ai constaté qu'il marche bien sauf qu'il ne copie pas toutes les données de la feuille comme les logos par exemple

 

[vgendron]

'il ne copie pas toutes les données de la feuille comme les logos par exemple

évidemment! tu as codé la suppression de ceux ci..

With ActiveWorkbook
  For Each s In .Sheets: s.DrawingObjects.Delete: Next

 

[donadoni16]

euh et comment je peux modifier le code pour copier les logos mais non pas les bouton de macro en ?

 

[vgendron]

toujours sans ton fichier contenant tous les types d'information.. donc. sans test de ma part

Option Explicit


Sub ExporterFiche()
Dim s As Object
Dim NomOnglet As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
NomOnglet = ActiveSheet.Name
ActiveSheet.Copy
With ActiveWorkbook
  For Each s In .ActiveSheet.Shapes
    If s.Name Like "*Button*" Then
        s.Delete
    End If
    Next
   
  .SaveAs ThisWorkbook.Path & "\Fiche " & NomOnglet, 51
  .Close
End With
ActiveCell.Activate
End Sub

 

[donadoni16]

re,
ci-joint le fichier avec les images et le bouton
je souhaite enlever juste les boutons appelés Ajouter un Mois & KALIKO pendant l'exportation et préserver les autres formes

 

[vgendron]

suffit de tester le nom du bouton avant de supprimer... donc..

Option Explicit

Sub ExporterFiche()
Dim s As Object
Dim NomOnglet As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
NomOnglet = ActiveSheet.Name
ActiveSheet.Copy
With ActiveWorkbook
  For Each s In .ActiveSheet.Shapes
    'MsgBox s.Name
    If s.Name = "Ajouter Un Mois" Or s.Name = "kaliko" Then
        s.Delete
    End If
    Next
   
  .SaveAs ThisWorkbook.Path & "\Fiche " & NomOnglet, 51
  .Close
End With
ActiveCell.Activate
End Sub

 

[donadoni16]

Super, Merci beaucoup vgendron c'est excatement ce que je voulais