Copier en additionnant un onglet

Bonjour,

J'ai réalisé un outil de devis automatisé qui me permet à partir d'un modèle de générer un devis type.

Depuis l'outil, seulement le premier onglet "MODELE" est copié puis coller dans un Excel "DEVIS" avec une mise en forme et l'apparition de certains boutons.

Tout fonctionne bien jusqu'ici....

Cela se complique quand je souhaite lui demander de copier et coller aussi mon deuxième onglet "Designation" dan ce même fichier...

Tout se passe bien pour le premier mais le second ne veut pas se copier en même temps...

Un coup de main please ???

Voici mon code :

Sub Archiver()

If Sheets("MODELE").Range("D20").Value = "" Then

MsgBox "Renseigner la date de validité du devis pour archiver."

Exit Sub

End If

Dim extension As String, msg As String, title As String, Response As String, Reference As String

Dim style As Integer

Application.ScreenUpdating = True 'False

ThisWorkbook.ActiveSheet.Copy

ActiveSheet.UsedRange.Activate

ActiveSheet.Unprotect

'ActiveSheet.UsedRange.Cells.Value = ActiveSheet.UsedRange.Cells.Value

extension = ".xlsx"

If ActiveSheet.Name = "MODELE" Then

chemin = ThisWorkbook.Path & "\DEVIS\"

nomfichier = ActiveSheet.Range("G12") & Format(Now(), "-mmmm" & "-yyyy") & "-D" & Format(ActiveSheet.Range("K4"), "0000") & extension

End If

MsgBox "Votre sauvegarde porte la référence : " & nomfichier

ActiveSheet.Unprotect

With ActiveWorkbook

With ActiveSheet.Shapes("Bouton 2").Select

Selection.Characters.Text = "Creer une Facture"

Selection.OnAction = "Facturation"

End With

With ActiveSheet.Shapes("Bouton 3").Select

Selection.Characters.Text = "Sauver modification"

Selection.OnAction = "RecapDevis"

End With

With ActiveSheet.Shapes("Bouton 4").Select

Selection.Characters.Text = "QUITTER"

Selection.OnAction = "Quitter"

End With

With ActiveSheet.Shapes("Bouton 5").Select

Selection.Font.ColorIndex = 15

Selection.Characters.Text = ""

Selection.OnAction = ""

End With

With ActiveSheet.Shapes("Bouton 6").Select

Selection.Characters.Text = "IMPRIMER"

Selection.OnAction = "Imprimer"

End With

With ActiveSheet.Shapes("Bouton 7").Select

Selection.Characters.Text = "PDF"

Selection.OnAction = "PDF"

End With

With ActiveSheet.Shapes("Bouton 8").Select

Selection.Font.ColorIndex = 15

Selection.Characters.Text = ""

Selection.OnAction = ""

End With

.Sheet("Designation").Copy

.SaveAs Filename:=chemin & nomfichier

.Close

Call RecapDevis

Call Ajouter

End With

End Sub

Bonjour,

Ça me parait un peu brouillon comme code... Je verrai bien quelque chose comme ça :

Sub Archiver()
'...
With ThisWorkbook 'ThisWorkbook c'est le classeur qui contient la macro
.Sheets("Designation").Copy
   ActiveWorkbook.SaveAs Filename:=chemin & nomfichier 
   'ActiveWorkbook c'est le nouveau classeur qui contient la feuille
   ActiveWorkbook.Close
End With
'...
End Sub

Attention ! Dans ton code :

.Sheet("Designation").Copy  'il manque un "s" à la fin de Sheet...

A+

Ça marche ! Je teste ça tout à l'heure et je te tiens au jus !

Merci et bonne soirée 🙂

Bonjour,

Après plusieurs tests suivant la proposition précédente voici le résultat :

1- Le fichier conserve bien la mise en forme du premier onglet et crée un fichier Devis. -> OK

2- Les deux onglets "MODELE" & "Designation" sont extraits -> OK

Le problème résiduel est que les 2 onglets "MODELE" & "Designation" sont extraits et collés dans 2 classeurs différents au lieu d'être intégrés dans le même.

Voici le code :

Sub Archiver()

Dim extension As String, msg As String, title As String, Response As String, Reference As String

Dim style As Integer

Application.ScreenUpdating = True 'False

ThisWorkbook.ActiveSheet.Copy

ActiveSheet.UsedRange.Activate

ActiveSheet.Unprotect

'ActiveSheet.UsedRange.Cells.Value = ActiveSheet.UsedRange.Cells.Value

extension = ".xlsx"

If ActiveSheet.Name = "MODELE" Then

chemin = ThisWorkbook.Path & "\DEVIS\"

nomfichier = ActiveSheet.Range("G12") & Format(Now(), "-mmmm" & "-yyyy") & "-D" & Format(ActiveSheet.Range("K4"), "0000") & extension

End If

MsgBox "Votre sauvegarde porte la référence : " & nomfichier

ActiveSheet.Unprotect

With ActiveWorkbook

With ActiveSheet.Shapes("Bouton 2").Select

Selection.Characters.Text = "Creer une Facture"

Selection.OnAction = "Facturation"

End With

With ActiveSheet.Shapes("Bouton 3").Select

Selection.Characters.Text = "Sauver modification"

Selection.OnAction = "RecapDevis"

End With

With ActiveSheet.Shapes("Bouton 4").Select

Selection.Characters.Text = "QUITTER"

Selection.OnAction = "Quitter"

End With

With ActiveSheet.Shapes("Bouton 5").Select

Selection.Font.ColorIndex = 15

Selection.Characters.Text = ""

Selection.OnAction = ""

End With

With ActiveSheet.Shapes("Bouton 6").Select

Selection.Characters.Text = "IMPRIMER"

Selection.OnAction = "Imprimer"

End With

With ActiveSheet.Shapes("Bouton 7").Select

Selection.Characters.Text = "PDF"

Selection.OnAction = "PDF"

End With

With ActiveSheet.Shapes("Bouton 8").Select

Selection.Font.ColorIndex = 15

Selection.Characters.Text = ""

Selection.OnAction = ""

End With

With ThisWorkbook.Sheets("Designation").Copy

End With

.SaveAs FileName:=chemin & nomfichier

.Close

Call RecapDevis

Call Ajouter

End With

End Sub

UP svp