Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2016 Macro qui rame

  • Initiateur de la discussion Initiateur de la discussion MaiT29
  • Date de début Date de début
M

MaiT29

XLDnaute Nouveau
Bonjour, j'ai cherché la réponse à mon problème sur ce forum mais je ne l'ai pas trouvé.

J'utilise une macro qui copie les données remplies sur un formulaire, et les colle sur une liste de données. La macro fonctionne, toutes les données s'affichent sur la liste. Seulement quand j'active la macro, elle met beaucoup de temps à marcher et un gros bug s'affiche à l'écran (ça rame). Je n'arrive pas à savoir si c'est le code qui est incomplet ou s'il est trop long.

Est ce que vous pourriez m'aider à résoudre ce problème?

Je vous joins le code entier ci dessous.

Merci d'avance



Sub SaisieSortie()
'
' SaisieSortie Macro
'

'
Sheets("Liste saisie des stocks").Select
Rows("5:5").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A5").Select
Sheets("Saisie SORTIES").Select
Range("C8").Select
Selection.Copy
Sheets("Liste saisie des stocks").Select
ActiveSheet.Paste
Sheets("Saisie SORTIES").Select
Range("C11").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Liste saisie des stocks").Select
Range("B5").Select
ActiveSheet.Paste
Sheets("Saisie SORTIES").Select
Range("E11").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Liste saisie des stocks").Select
Range("C5").Select
ActiveSheet.Paste
Sheets("Liste saisie des stocks").Select
Range("D5").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Sortie"
Range("E5").Select
Sheets("Saisie SORTIES").Select
Range("E8").Select
Selection.Copy
Sheets("Liste saisie des stocks").Select
ActiveSheet.Paste
Range("F5").Select
Sheets("Saisie SORTIES").Select
Range("G8").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Liste saisie des stocks").Select
ActiveSheet.Paste
Sheets("Saisie SORTIES").Select
Range("C14").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Liste saisie des stocks").Select
Range("G5").Select
ActiveSheet.Paste
Sheets("Saisie SORTIES").Select
Range("C17").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Liste saisie des stocks").Select
Range("H5").Select
ActiveSheet.Paste
Sheets("Saisie SORTIES").Select
Range("C20").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Liste saisie des stocks").Select
Range("I5").Select
ActiveSheet.Paste
Sheets("Saisie SORTIES").Select
Range("E20").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Liste saisie des stocks").Select
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
Range("L5").Select
ActiveSheet.Paste
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Rows("5:5").Select
Application.CutCopyMode = False
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Font.Bold = True
Selection.Font.Bold = False
With Selection.Font
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.TintAndShade = 0
End With
With Selection.Font
.Name = "Century Gothic"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Range("B5").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
:=xlBetween
.IgnoreBlank = True
.InCellDropdown = True
.ShowInput = True
.ShowError = True
End With
Range("E5").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
:=xlBetween
.IgnoreBlank = True
.InCellDropdown = True
.ShowInput = True
.ShowError = True
End With
Range("F5").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
:=xlBetween
.IgnoreBlank = True
.InCellDropdown = True
.ShowInput = True
.ShowError = True
End With
Range("G5").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
:=xlBetween
.IgnoreBlank = True
.InCellDropdown = True
.ShowInput = True
.ShowError = True
End With
Range("H5").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
:=xlBetween
.IgnoreBlank = True
.InCellDropdown = True
.ShowInput = True
.ShowError = True
End With
Range("I5").Select
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Range("A5:L5").Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Sheets("Liste saisie des stocks").Select
Range("A5").Select
Sheets("Saisie SORTIES").Select
Range("E20,C20,C17,C14").Select
Range("C14").Activate
Selection.ClearContents
Range("C14").Select
End Sub
 
Trier par date Trier par votes

Jacky67

XLDnaute Barbatruc
Bonjour,
Commence par éliminer tous ces "select" inutiles
Par exemple comme ceci
VB: 
Sub SaisieSortie()
    Sheets("Liste saisie des stocks").Select    ' sera la feuille active
Rows("5:5").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
With Sheets("Saisie SORTIES")
.[C8].Copy [a5]
.[C11].Copy [B5]
.[E11].Copy [C5]
[D5] = "Sortie"
.[E8].Copy [E5]
'etc..
'etc
End With
End Sub
Je n'ai fait que les 4 premières copy, pour l'exemple, à toi de faire la suite
Puis supprimer tous les "ActiveWindow.ScrollColumn"
Ensuite on verra pour la suite.(Avec un classeur joint)

Bon courage
 
Dernière édition:
Vote positif 0 Vote négatif
P

Patrice MARIE

XLDnaute Nouveau
Bonjour,

Si le problème n'est pas encore résolu, tu peux ajouter 2 lignes de commandes en début de macro. La 1ère bloque l'affichage et la 2èm bloque les calculs.

En fin de macro il faut rétablir ces 2 fonctions.

Cela donne :

Application.ScreenUpdating = 0
Application.Calculation = xlCalculationManual
;;;
;;;
;;;
Application.ScreenUpdating = 1
Application.Calculation = xlCalculationAutomatic

end sub

Tiens moi au courant
 
Vote positif 0 Vote négatif
G

Glenonn

XLDnaute Nouveau
Tu n'aur
Pas posible d'avoir le fichier Excel ?
 
Vote positif 0 Vote négatif

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonsoir tout le monde,
Ce code, c'est de l'enregistrement macro pur ?
J'ai optimisé les copier/coller et viré tout ce qui ne sert à rien. Execution sur mon PC : 16ms
Je n'ai pas touché à la mise en forme car vraiment j'ai pas tout compris. On peut aussi en VBA ajouter des commentaires. Ca aide.
J'ai trouvé des trucs comme ça :
VB: 
Selection.Font.Bold = True
Selection.Font.Bold = False
A mon avis on peut encore un peu optimisé.
 

Pièces jointes

  • Améliore.xlsm
    19.8 KB · Affichages: 4
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

M
  • Question Question
Microsoft 365 deux macros succesives et un bouton
2
Réponses
17
Affichages
820
MICHAEL
M
  • Question Question
Autres fenêtre "Publication"
Réponses
10
Affichages
444
ph.vanne
H
  • Résolu(e)
XL 2016 Copier cellule dans un autre onglets
2
Réponses
16
Affichages
363
Phil69970
G
  • Question Question
XL 2019 Sélectionner un fichier pour mettre à jour une base de données
Réponses
3
Affichages
187
sylvanu
  • Résolu(e)
XL 2021 Exécuter une macro sur plusieurs feuilles
Réponses
9
Affichages
331
micie1509
R
  • Résolu(e)
XL 2019 creer une macro pour copier des info d un onglet a un autre dans le meme classeur
Réponses
4
Affichages
542
robpellan52
R
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
2 K
AtTheOne
F
  • Résolu(e)
XL 2021 Créer Macro permettant d'indexer des nouveaux clients ? [Résolu]
4 5 6
Réponses
82
Affichages
3 K
fanou06
F
N
  • Résolu(e)
Microsoft 365 Macro copier/coller entre deux tableaux structurés
3 4 5
Réponses
66
Affichages
1 K
job75
P
  • Question Question
Microsoft 365 Macro qui plante exel
Réponses
1
Affichages
461
mapomme
K
  • Question Question
XL 2019 Organiser le code VBA
Réponses
9
Affichages
804
Kevin38
K
  • Question Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
1 K
Nicolas JACQUIN
M
  • Question Question
Microsoft 365 Macro VBA supprimer une colonne
Réponses
5
Affichages
364
marie3107
M
D
  • Résolu(e)
Microsoft 365 Validation des données avec formule + liste déroulante dans la même cellule
Réponses
8
Affichages
910
de_hanstrapp
D
L
  • Question Question
XL 2016 Macro et suppressions de lignes
Réponses
9
Affichages
803
fanfan38
  • Résolu(e)
XL 2021 Ecrire dans une une autre feuille
Réponses
3
Affichages
513
Usine à gaz
F
  • Question Question
Microsoft 365 Poursuivre ou pas la macro
Réponses
2
Affichages
403
Francky79
F
O
  • Question Question
XL 2010 aide sur code VBA collationnement de données
Réponses
10
Affichages
710
olivier388
O
  • Résolu(e)
Microsoft 365 Macro fonctionnant avec excel 365 sur windows 11 mais ne fonctionnent pas sur un autre windows 11 avec aussi un excel 365
Réponses
11
Affichages
874
mouchtre
F
  • Résolu(e)
XL 2021 Réaliser une macro pour copier une ligne avec formule ?
Réponses
4
Affichages
564
fanou06
F
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…