Code Copie et Mise en forme trop long

[Zouzou93]

Bonjour,

Voilà, je viens de réaliser mon premier code (Grace à l'aide de nombreux exemples du site). Cela dit je ne suis pas encore satisfaite du résultat.
Le code consiste à copier (Uniquement les valeurs et non les formules) une feuille nommée "Offre" d'un classeur nommé "Cotation", l'enregistrer sous un répertoire "Archives Cotations" sous un numéro dont le format est : Code Agence+Année+Mois+Numéro de cotation.

Y aurait un code copier-Mise en format plus court et qui rendrait pour le coup la macro + efficace ?
Ci après copie du code.
Merci de votre aide
Zouzou93


Sub Enregistre()
Application.StatusBar = "Veuillez Patienter SVP"

[G1].Value = [G1].Value + 1
Range("E1:G1").Select
Selection.Font.ColorIndex = 0
Cells.Select
Selection.Copy
Workbooks.Add
Cells.Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.787401575)
.RightMargin = Application.InchesToPoints(0.787401575)
.TopMargin = Application.InchesToPoints(0.984251969)
.BottomMargin = Application.InchesToPoints(0.984251969)
.HeaderMargin = Application.InchesToPoints(0.4921259845)
.FooterMargin = Application.InchesToPoints(0.4921259845)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
End With
Range("D3").Select
Application.StatusBar = False
ThisWorkbook.Save
ChDir "Z:\documents\Outils\ARCHIVES COTATIONS\"
ActiveWorkbook.SaveAs Filename:="Z:\documents\Outils\ARCHIVES COTATIONS\" & [E1].Value & " " & Format([F1].Value, "yyyymm") & " " & [G1] & ".xls", FileFormat:=xlNormal
ActiveWorkbook.Close (False)

msg = "Votre Cotation a été sauvegardée"
Title = "Sauvegarde de la cotation actuelle"
Style = vbOKOnly + vbInformation
Reponse = MsgBox(msg, Style, Title)

End Sub

 

[pierrejean]

Re : Code Copie et Mise en forme trop long

Bonjour Zouzou93

A mon avis le delai le plus long est probablement du a la mise en page
Si cette mise en page est celle du document copié il pourrait etre plus rapide de faire une copie integrale de la feuille puis modifier les formules (passer en valeurs)
Un fichier exemple (sans données confidentielles ) nous aiderait a chercher la meilleure solution

 

[Zouzou93]

Re : Code Copie et Mise en forme trop long

Bonjour PierreJean,

Ci joint exemple du format de l'offre à copier.
En fait toutes les cellules ont des liaisons de différents fichiers externes.
Et l'idéal serait de reproduire l'offre sans formules ni liaisons juste le format et les valeurs.

Merci par avance
Zouzou

 

[Staple1600]

Re : Code Copie et Mise en forme trop long

Bonjour à tous

edit: fil du forum retrouvé : Mise en page MacroXL4

Une façon d'accélérer la mise en page
Accélérer la mise en page effectuée en Visual Basic

et ici pus spécifiquement pour Excel
McGimpsey & Associates : Excel : Bypassing Slow VBA PageSetup

Et sur le forum , j'ai passé quelques exemples utilisant cette syntaxe

 

[Zouzou93]

Re : Code Copie et Mise en forme trop long

Merci pour le lien que j'ai consulté mais je ne sais pas comment l'adapter.
Merci
Zouzou

 

[pierrejean]

Re : Code Copie et Mise en forme trop long

Re

Salut Staple

Zouzou

teste la macro ci-dessous

Sub Enregistre()
Application.StatusBar = "Veuillez Patienter SVP"
[G1].Value = [G1].Value + 1
Range("E1:G1").Font.ColorIndex = 0
ActiveSheet.Copy
Cells.Copy
Cells.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
Application.CutCopyMode = False
Range("D3").Select
Application.StatusBar = False
ThisWorkbook.Save
ChDir "Z:\documents\Outils\ARCHIVES COTATIONS\"
ActiveWorkbook.SaveAs Filename:="Z:\documents\Outils\ARCHIVES COTATIONS\" & [E1].Value & " " & Format([F1].Value, "yyyymm") & " " & [G1] & ".xls", FileFormat:=xlNormal
ActiveWorkbook.Close (False)
msg = "Votre Cotation a été sauvegardée"
Title = "Sauvegarde de la cotation actuelle"
Style = vbOKOnly + vbInformation
Reponse = MsgBox(msg, Style, Title)
End Sub

 

[Zouzou93]

Re : Code Copie et Mise en forme trop long

Super Géant PierreJean ... Plus rien à voir c'est presque quai instantané.
Merci ... Merci ... Merci PierreJean encore pour ton aide précieuse.
A bientôt
Zouzou

 

[Zouzou93]

Re : Code Copie et Mise en forme trop long

Bonsoir PierreJean ... Il est un peu tard ... Je sais et ça attendra bien demain.
Je te disais que la maco fonctionne très bien, que la recopie, l'enregistrement se font très bien. Par contre je viens de mettre mon dossier dans un répertoire réseau afin de pouvoir le partager sur notre intranet.
Toutes les fonctions marchent bien à part la recopie qui se fait non pas sur un autre classeur mais dans le même classeur (En créant un nouvel onglet) et me sauvegarde la totalité du classeur d'origine qui pèse 2,5MO... Ce qui est énorme.

Pouvez vous m'aider à règler ce problème pour le moins ennuyeux.

Merci beaucoup
Zouzou

 

[pierrejean]

Re : Code Copie et Mise en forme trop long

bonjour Zouzou

je suis bien embarassé car je n'ai pas la possibilté de tester avec un reseau

a premiere vue le

ActiveSheet.Copy

ne fonctionne pas normalement puisqu'il devrait creer un nouveau classeur

tu n'as pas modifié cette ligne ?

 

[pierrejean]

Re : Code Copie et Mise en forme trop long

Re

A tester

Sub Enregistre()
Application.StatusBar = "Veuillez Patienter SVP"
[G1].Value = [G1].Value + 1
Range("E1:G1").Font.ColorIndex = 0
Cells.Copy
Workbooks.Add (xlWBATWorksheet)
ActiveSheet.Cells.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
Application.CutCopyMode = False
Range("D3").Select
Application.StatusBar = False
ChDir "Z:\documents\Outils\ARCHIVES COTATIONS\"
ActiveWorkbook.SaveAs Filename:="Z:\documents\Outils\ARCHIVES COTATIONS\" & [E1].Value & " " & Format([F1].Value, "yyyymm") & " " & [G1] & ".xls", FileFormat:=xlNormal
ActiveWorkbook.Close (False)
msg = "Votre Cotation a été sauvegardée"
Title = "Sauvegarde de la cotation actuelle"
Style = vbOKOnly + vbInformation
Reponse = MsgBox(msg, Style, Title)
End Sub

 

[Zouzou93]

Re : Code Copie et Mise en forme trop long

Merci mille fois PierreJean pour ton aide, mais je viens de tester et le débogeur surligne : Workbooks.Add (xlWBATWorksheet)
y aurait-il peut être un autre moyen de partager mon classeur en réseau (et non en intranet (s'il n'y a effectivement pas de solution). Cela dit le partage concerne une cinquantaine de personnes dans qui utiliseront ce cotateur plusieurs fois par jour. Serait ce une alternative à l'intranet ?

Merci de votre aide et de vos conseils en la matière.

Zouzou

 

[pierrejean]

Re : Code Copie et Mise en forme trop long

Re

l'intranet est un reseau

et dans ce domaine je ne suis absolument pas competent

tout ce que je peux te suggerer c'est de tester

Workbooks.Add

au lieu de

Workbooks.Add (xlWBATWorksheet)

mais je n'y crois pas trop

sinon voir avec le gestionnaire de l'intranet (c'est peut-etre lui qui interdit l'apport de fichier autrement que par un operateur identifié)