Simplification Macro

Résolu/Fermé
scelera Messages postés 39 Date d'inscription lundi 10 juin 2013 Statut Membre Dernière intervention 3 décembre 2021 - 10 janv. 2014 à 08:31
scelera Messages postés 39 Date d'inscription lundi 10 juin 2013 Statut Membre Dernière intervention 3 décembre 2021 - 10 janv. 2014 à 10:58
Bonjour,

J'ai créé cette macro mais le probléme, lorsque je l'éxecute, c'est qu'elle est longue à se réaliser ! Alors je voulais savoir si quelqu'un qui s'y connait bien mieux que moi pouvais la simplifier. Merci beaucoup de votre aide !!!
Cordialement.




Sub Macro1()
'
' Macro1 Macro
'
' Touche de raccourci du clavier: Ctrl+r
'
Sheets("Feuil2").Select
Cells.Select
Selection.Delete Shift:=xlUp
Sheets("Feuil1").Select
Columns("G:G").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Feuil2").Select
Columns("A:A").Select
ActiveSheet.Paste
Columns("A:A").EntireColumn.AutoFit
Sheets("Feuil1").Select
Columns("H:H").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Feuil2").Select
Columns("B:B").Select
ActiveSheet.Paste
Columns("B:B").EntireColumn.AutoFit
Sheets("Feuil1").Select
Columns("I:I").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Feuil2").Select
Columns("C:C").Select
ActiveSheet.Paste
Sheets("Feuil1").Select
Columns("J:J").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Feuil2").Select
Columns("D:D").Select
ActiveSheet.Paste
Columns("D:D").EntireColumn.AutoFit
Sheets("Feuil1").Select
Columns("O:O").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Feuil2").Select
Columns("E:E").Select
ActiveSheet.Paste
Sheets("Feuil1").Select
ActiveWindow.SmallScroll ToRight:=18
Columns("AK:AK").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Feuil2").Select
Columns("F:F").Select
ActiveSheet.Paste
Columns("F:F").EntireColumn.AutoFit
Sheets("Feuil1").Select
Columns("AL:AL").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Feuil2").Select
Columns("G:G").Select
ActiveSheet.Paste
Columns("G:G").EntireColumn.AutoFit
Sheets("Feuil1").Select
ActiveWindow.LargeScroll ToRight:=-1
Columns("AH:AH").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Feuil2").Select
Columns("H:H").Select
ActiveSheet.Paste
Sheets("Feuil1").Select
ActiveWindow.LargeScroll ToRight:=1
Columns("AG:AG").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Feuil2").Select
Columns("I:I").Select
ActiveSheet.Paste
Sheets("Feuil1").Select
Columns("K:K").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Feuil2").Select
Columns("J:J").Select
ActiveSheet.Paste
Sheets("Feuil2").Select
Range("A1:J1").Select
Range("J1").Activate
Application.CutCopyMode = False
Selection.AutoFilter
ActiveWindow.View = xlPageLayoutView
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = "&""Arial,Gras""&20&UExtrait de nos références"
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.75)
.BottomMargin = Application.InchesToPoints(0.75)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 57
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
ActiveSheet.PageSetup.RightHeaderPicture.Filename = "P:\Extrait de nos références Macro\Logo TLS.png"
ActiveSheet.PageSetup.RightHeader = "&G"
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = "&""Arial,Gras""&20&UExtrait de nos références"
.RightHeader = "&G"
.LeftFooter = ""
.CenterFooter = _
"TL Systèmes - 41 rue Albert Einstein - Parc d'activitè St- Jacques II - 54320 MAXEVILLE - Tél: 03 83 39 70 00 - www.tl-systemes.fr"
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.75)
.BottomMargin = Application.InchesToPoints(0.75)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
.Zoom = 57
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
End Sub
A voir également:

2 réponses

dlt-pan Messages postés 481 Date d'inscription jeudi 17 mai 2007 Statut Membre Dernière intervention 23 décembre 2014 67
10 janv. 2014 à 10:31
bonjour
tu ajoutes au debut après Sub...

Application.ScreenUpdating = False

et à la fin avant End sub

Application.ScreenUpdating = True

l'ecran sera figé, çà ira beaucoup plus vite
1
scelera Messages postés 39 Date d'inscription lundi 10 juin 2013 Statut Membre Dernière intervention 3 décembre 2021
10 janv. 2014 à 10:58
Merci beaucoup @dlt-pan, c'est nickel !
0