Modification de code pour Enregistrement de deux onglets

[maval]

Bonjour

J'ai un code pour enregistrer mon onglet actif je recherche a modifier mon code pour enregistrer les deux première feuille

je vous remercie d'avance

mon code:

Sub Archiver()

Dim extension As String
Dim chemin As String, nomfichier As String
Dim style As Integer
Application.ScreenUpdating = False
ThisWorkbook.ActiveSheet.Copy
extension = ".xlsm"
chemin = "C:\Users\Max\Desktop\Test\"
nomfichier = ActiveSheet.Range("A1") ' & extension
With ActiveWorkbook
      .ActiveSheet.DrawingObjects(2).Delete
    .SaveAs Filename:=chemin & nomfichier
    .Close
End With
End Sub

 

[camarchepas]

Re : Modification de code pour Enregistrement de deux onglets

Re ,

Devant la Claire-voyance du Tigre , je m'exécute ; (Bon virtuellement bien sûr )

Sub test()
 Dim i As Integer, x As String, chemin As String
 Dim s As button
  Application.DisplayAlerts = False
 
 For i = 10 To 3 Step -1
      Sheets(i).Delete
  Next i
  Application.DisplayAlerts = True
  
' Destruction des boutons sur la feuille
    For Each s In ActiveSheet.Buttons
     If s.Name <> "Menu, dudu" Then s.Delete
    Next
  
  chemin = "C:\Users\Dédé\Desktop\Text\"
  x = ActiveSheet.Range("K1")
  If x = "" Then MsgBox "Le nom de fichier n'est pas renseigné ....., carton rouge": Exit Sub
  If Dir(chemin & x) <> "" Then MsgBox " Et oui , il est déjà existant ": Exit Sub
  
  ThisWorkbook.SaveAs chemin & x ,xlOpenXMLWorkbookMacroEnabled
 

 End Sub

 

[job75]

Re : Modification de code pour Enregistrement de deux onglets

Bonjour maval, Pierrot, camarchepas,

Avec le fichier de l'autre fil et cette macro :

Sub Archiver()
Dim ext$, chemin$, nomfich$, formatfich, nom$, i%, o As Object
ext = ".xlsm" '.xls
chemin = ThisWorkbook.Path & "\" '"C:\Users\Max\Desktop\Test\"
nomfich = ThisWorkbook.Sheets(1).[K1]
formatfich = xlWorkbookNormal
If Val(Application.Version) >= 12 Then _
formatfich = IIf(ext = ".xls", 56, 52)
nom = ThisWorkbook.Name 'mémorise le nom
ThisWorkbook.Save 'au cas où...
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For i = Sheets.Count To 3 Step -1
  Sheets(i).Delete
Next
For Each o In Sheets(1).DrawingObjects
  If o.Name <> "dudu" And Not o.Name Like "SP*" Then o.Delete
Next
On Error Resume Next 'si nomfich n'est pas autorisé
ThisWorkbook.SaveAs chemin & nomfich, formatfich
Workbooks.Open chemin & nom 'rouvre le fichier
ThisWorkbook.Close False
End Sub

A+

 

[maval]

Re : Modification de code pour Enregistrement de deux onglets

Re,

mais j'ai peut être pas toutes les billes pour savoir ce que tu veux réellement faire

En fait j'ai un fichier avec des carte du monde diviser en (Shapes) et des codes pour des carte du monde , et a chaque fois, je change de carte qui se trouve dans la feuille (1) et dans la feuille (2) la BD.
Et sur les autres feuilles j'ai toutes les cartes du monde donc quand j'enregistre, seul les deux première feuille sont enregistrer avec les cartes.
Voilà mon bute!

 

[maval]

Re : Modification de code pour Enregistrement de deux onglets

Bonjour Job

Merci pour le code sa fonctionne nickel.

Pour rajouter un contrôle ex: Menu-2 au code ci dessous comment proceder

For Each o In Sheets(1).DrawingObjects
  If o.Name <> "Menu" And Not o.Name Like "SP*" Then o.Delete
Next

Merci d'avance et bonne journée

 

[job75]

Re : Modification de code pour Enregistrement de deux onglets

Bis repetita,

(...) avec 1240 posts vous pouviez adapter tout seul

 

[maval]

Re : Modification de code pour Enregistrement de deux onglets

re,

merci