Modification de code pour Enregistrement de deux onglets

  • Initiateur de la discussion Initiateur de la discussion maval
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

maval

XLDnaute Barbatruc
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:
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
 
Re : Modification de code pour Enregistrement de deux onglets

Bonjour,

Suite au code de Pierrot que je remercie et salut au passage. Le code fonctionne très bien mais lorsque j'enregistre le fichier avec ce code sa me prend pas les modules standard ou se trouve tous mes codes.
Y a t-il un moyen ?

Code:
Sub test()
Dim i As Integer, x As String, chemin As String
Workbooks("Matrise.xlsm").Save
Application.DisplayAlerts = False
For i = 10 To 3 Step -1
     Sheets(i).Delete
     Next i
     
Application.DisplayAlerts = True
x = ActiveSheet.Range("K1")
chemin = "C:\Users\Dédé\Desktop\Text\"
If x <> "" Then ActiveWorkbook.SaveAs chemin & x

' Destruction des boutons sur la feuille

Dim s As Object
  For Each s In ActiveSheet.Buttons
    If s.Name <> "Menu, dudu" Then s.Delete
    Next

End Sub

Merci d'avance
 
Re : Modification de code pour Enregistrement de deux onglets

Bonjour Pierrot , Maval,

Et hop, carton jaune

En effet cela devient FATIGUANT de voir à quelle vitesse tu crées de nouvelles discussions sur le même sujet , en oubliant toutes les réponses déjà faite .

Il faudrait peut être t'abonner aux discussions que tu veux suivre ....

Sinon tu finiras par prendre un carton rouge ... lol
 
Re : Modification de code pour Enregistrement de deux onglets

Bonjour Pierrot , Maval

Bon en même temps qu'un nouveau carton jaune voici la solution du Tigre adaptée , attention le clé en main dépend toujours de la serrure ....
if range("K1") = "" then msgbox "Le nom de fichier n'est pas renseigné ....., carton rouge":exit sub

ActiveWorkbook.SaveAs range("K1"), xlOpenXMLWorkbookMacroEnabled
 
Re : Modification de code pour Enregistrement de deux onglets

Bonjour Nono,

Malgré toutes les engueulades que tu me fait je ne t'en veut pas, Le problème a mon âge on ne fait plus attention a ceci

Je te remercie infiniment a part que! lorsque j'enregistre tous se passe bien et a chaque fois il me met un message me disant que le fichier existe déjà alors qu'il n'existé pas avant Bof........

Bonne journée
 
Re : Modification de code pour Enregistrement de deux onglets

Re ,

Pour l'age , tu as juste un an de plus que moi , donc non déterminant , nous sommes encore trés jeunes à peine séniors.....

Essaies de coller cette macro et dis moi quoi .

Code:
Sub dd()

If Range("K1") = "" Then MsgBox "Le nom de fichier n'est pas renseigné ....., carton rouge": Exit Sub
If Dir(Range("K1")) <> "" Then MsgBox " Et oui , il est déjà existant ": Exit Sub
ActiveWorkbook.SaveAs Range("K1"), xlOpenXMLWorkbookMacroEnabled
End Sub

Si cela donne encore la même chose, y'a-t-il une événementiel dans le thisworkbook pour le beforesave ?
 
Re : Modification de code pour Enregistrement de deux onglets

Re ,

Voici donc le code de la macro test que tu as composé :

Code:
Sub test()
Dim i As Integer, x As String, chemin As String

'If Range("K1") = "" Then MsgBox "Le nom de fichier n'est pas renseigné .....,": Exit Sub
'ActiveWorkbook.SaveAs Range("K1"), xlOpenXMLWorkbookMacroEnabled

If Range("K1") = "" Then MsgBox "Le nom de fichier n'est pas renseigné ....., carton rouge": Exit Sub
If Dir(Range("K1")) <> "" Then MsgBox " Et oui , il est déjà existant ": Exit Sub
 ActiveWorkbook.SaveAs Range("K1"), xlOpenXMLWorkbookMacroEnabled


Application.DisplayAlerts = False
For i = 10 To 3 Step -1
     Sheets(i).Delete
     Next i
     
Application.DisplayAlerts = True
x = ActiveSheet.Range("K1")
chemin = "C:\Users\Dédé\Desktop\Text\"
'If x <> "" Then ActiveWorkbook.SaveAs chemin & x

If x <> "" Then ThisWorkbook.SaveAs chemin & x

' Destruction des boutons sur la feuille
Dim s As Object
  For Each s In ActiveSheet.Buttons
    If s.Name <> "Menu, dudu" Then s.Delete
    Next
'Stop
End Sub

si tu regardes bien où ton code s'arrête , ce n'est pas ici :

ActiveWorkbook.SaveAs Range("K1"), xlOpenXMLWorkbookMacroEnabled

mais là

ThisWorkbook.SaveAs chemin & x


Pourquoi sauvegarder 2 fois le même classeur ?
et donc pas étonnant qu'il le trouve la 2eme fois

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

Code:
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
 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

' Destruction des boutons sur la feuille
  For Each s In ActiveSheet.Buttons
    If s.Name <> "Menu, dudu" Then s.Delete
   Next
End Sub
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
4
Affichages
227
  • Question Question
Microsoft 365 Code VBA
Réponses
10
Affichages
862
  • Question Question
Microsoft 365 Code VBA
Réponses
7
Affichages
821
Retour