XL 2013 Exporter Onglets dans un nouveau classeur (VBA)

susaita

XLDnaute Occasionnel
Bonsoir à tous,
dans le fichier ci-inclus j'ai 3 onglets que je veux copier dans un nouveau classeur avec les conditions suivantes :

*le nouveau fichier garde les formules
*le nouvau fichier créé sera fermé
*le nouvau classeur créé prendra DS comme nom
*le fichier créé (DS) je veux qu'il soit dans le même dossier que le fichier ventes
*ne pas garder les boutons qui se trouvent dans les onglets
*ne pas garder le code vba dans le nouveau classeur
*les onglets crées doivent garder leur couleur d'origines (rouge,vert et bleu)
*la hauteur des lignes et la largeur es colonnes restera la même que celle du classeur d'origine

Merci d'avance
 

Pièces jointes

  • Ventes.xlsx
    25.3 KB · Affichages: 84
Dernière édition:

job75

XLDnaute Barbatruc
Re,

Pour savoir d'où vient le problème ajoutez un blocage intermédiaire :
Code:
Sub Exporter()
Dim s As Object
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets(Array("MO Qte", "BETON Qte", "ACIER Qte")).Copy
Exit Sub 'blocage pour tester
With ActiveWorkbook
  For Each s In .Sheets: s.DrawingObjects.Delete: Next
  .SaveAs ThisWorkbook.Path & "\DS", 51
  .Close
End With
ActiveCell.Activate
End Sub
Si les couleurs du document créé sont modifiées le problème vient de la sélection multiple des 3 feuilles.

Sinon il vient de la commande SaveAs.

Dans les 2 cas ce serait un bug de votre version Windows ou Excel.

Nota : j'espère que les couleurs incriminées ne viennent pas d'une MFC...

A+
 
Dernière édition:

susaita

XLDnaute Occasionnel
Bonsoir Job, le Forum
je vous contacte après une longue absence pour solliciter votre aide par rapport au code d'exportation que vous m'avez donné dans ce sujet :

VB:
Sub ExporterDS()
Dim s As Object
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets(Array("MO Qte", "BETON Qte", "ACIER Qte")).Copy
With ActiveWorkbook
  For Each s In .Sheets: s.DrawingObjects.Delete: Next
  .SaveAs ThisWorkbook.Path & "\DS", 51
  .Close
End With
ActiveCell.Activate
End Sub

j'ai remarqué un petit problème dans le fichier exporté (DS). ce dernier indique un message <<la mise à jour automatique des liens à été désactivé>> et cela m'oblique à chaque fois de me rendre vers données > modifier les liens pour rompre la liaison avec le fichier d'origine.

ma demande c'est d'ajouter une commande à mon code pour éviter ce problème

Merci d'avance
 
Dernière édition:

job75

XLDnaute Barbatruc
Bonsoir susaita,

Pour rompre toutes les liaisons dans le fichier créé :
Code:
Sub Exporter()
Dim s As Object, lien, i&
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets(Array("MO Qte", "BETON Qte", "ACIER Qte")).Copy
With ActiveWorkbook
  For Each s In .Sheets: s.DrawingObjects.Delete: Next
  lien = .LinkSources
  If Not IsEmpty(lien) Then
    For i = 1 To UBound(lien)
      .BreakLink lien(i), xlExcelLinks
    Next
  End If
  .SaveAs ThisWorkbook.Path & "\DS", 51
  .Close
End With
ActiveCell.Activate
End Sub
A+
 

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 949
Membres
101 851
dernier inscrit
vaiata