Macro - exécution longue

Usine à gaz

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Bonjour à tous,

Avec mes petites connaissances ... et votre aide, j'ai fait cette macro :

Code: 
Sub Saisie()
'
' Saisie Macro
' Macro enregistrée le 12/03/2002 par Jean-Pierre ROTH
'

'
    Application.ScreenUpdating = False
    Sheets("Saisie").Select
    ActiveSheet.Unprotect
    
    With ActiveWindow
        .DisplayHorizontalScrollBar = False
        .DisplayVerticalScrollBar = False
    End With
    Application.WindowState = xlMinimized
    '******************************************************************
    'ActiveSheet.ShowDataForm  ' grille aux formats US
    Application.CommandBars.FindControl(ID:=860).Execute ' grille aux formats locaux : FR
    '********************************************************************
    
    ActiveWindow.ScrollRow = 1
    With ActiveWindow
        .DisplayHorizontalScrollBar = True
        .DisplayVerticalScrollBar = True
    End With
    
    ActiveWindow.ScrollRow = 1
    ActiveWindow.ScrollColumn = 1
    
    Application.DisplayFullScreen = False
    ActiveWindow.DisplayHeadings = True
    Application.DisplayFormulaBar = True
    ActiveWindow.DisplayHeadings = True
    
    Application.Goto Reference:="R1C1"
    
    Range("AG1:BT1").Select
    Selection.Copy
    Range("AG2:BT1000").Select
    ActiveSheet.Paste
    
    Columns("A:A").Select
    Selection.Copy
    Columns("B:B").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Infos               agenda              client - NE RIEN ECRIRE "
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Columns("B:B").Select
    Selection.Locked = False
    Selection.FormulaHidden = False
    
    On Error Resume Next
    Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    
    Range("B2").Select
    
    ActiveWindow.ScrollColumn = 5
    Application.WindowState = xlMaximized
    Sheets("Clients").Select
    Sheets("Saisie").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Application.ScreenUpdating = True
    ActiveWorkbook.Save
End Sub

Elle fonctionne bien mais elle est très longue à l'exécution.

Je ne sais pas la rendre plus rapide ....

Peut-être pourriez-vous m'aider ?

Je sais que je vous pose beaucoup de questions .....
Je vous suis très reconnaissant de votre écoute et de toutes les solutions que vous m'apportez,

Dans un tas de domaines, tant professionnels ... et aussi dans la passion des oiseaux, je peux aider si vous avez besoin.

Encore merci,
Amicalement,
Lionel,
 
Trier par date Trier par votes
JBARBE

JBARBE

XLDnaute Barbatruc
Re : Macro - exécution longue

Bonjour à tous,

Peut-être ceci ( à tester)

Code: 
Sub Saisie()
'
' Saisie Macro
' Macro enregistrée le 12/03/2002 par Jean-Pierre ROTH
'

'
    Application.ScreenUpdating = False
    Sheets("Saisie").Select
    ActiveSheet.Unprotect
   
    With ActiveWindow
        .DisplayHorizontalScrollBar = False
        .DisplayVerticalScrollBar = False
    End With
    Application.WindowState = xlMinimized
    '******************************************************************
    'ActiveSheet.ShowDataForm  ' grille aux formats US
    Application.CommandBars.FindControl(ID:=860).Execute ' grille aux formats locaux : FR
    '********************************************************************
   
    ActiveWindow.ScrollRow = 1
    With ActiveWindow
        .DisplayHorizontalScrollBar = True
        .DisplayVerticalScrollBar = True
    End With
   
    ActiveWindow.ScrollRow = 1
    ActiveWindow.ScrollColumn = 1
   
    Application.DisplayFullScreen = False
    ActiveWindow.DisplayHeadings = True
    Application.DisplayFormulaBar = True
    ActiveWindow.DisplayHeadings = True
   
    Application.Goto Reference:="R1C1"
   
    Range("AG1:BT1").Copy Range("AG2:BT1000")
   
    Columns("A:A").Select
    Selection.Copy
    Columns("B:B").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Infos               agenda              client - NE RIEN ECRIRE "
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
   
    Columns("B:B").Select
    Selection.Locked = False
    Selection.FormulaHidden = False
   
    On Error Resume Next
    Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
   
    Range("B2").Select
   
    ActiveWindow.ScrollColumn = 5
    Application.WindowState = xlMaximized
    Sheets("Clients").Select
    Sheets("Saisie").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Application.ScreenUpdating = True
    ActiveWorkbook.Save
End Sub

Quelques petites modif seulement, mais je pense qu'il n'y a pas grand chose à supprimer dans cette macro !
 
Vote positif 0 Vote négatif
Usine à gaz

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Re : Macro - exécution longue

Bonjour JBARBE
Bonjour à tous,

Merci pour votre gentillesse,
J'ai testé la nouvelle macro mais c'est toujours aussi long.

Je me demande si ça ne provient pas de mon classeur qui serait "pas normal" LOL
je vais tout copier dans un autre et je vous donnerai le résultat,

Amicalement,
Lionel,
 
Vote positif 0 Vote négatif
Usine à gaz

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Re : Macro - exécution longue

Bonjour à tous,

en fait j'ai séparé ma macro et j'en ai fait deux pour voir où pouvait se trouver mon soucis.
Mon soucis est là :

Sub CopieFormules()
'
' CopieFormules Macro
'

'
Application.ScreenUpdating = False
ActiveSheet.Unprotect
Range("AE1:BN1").Select
Selection.Copy
Range("AE2:BN1000").Select
ActiveSheet.Paste

Columns("A:A").Select
Selection.Copy
Columns("B:B").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("B1").Select
ActiveCell.FormulaR1C1 = "Infos agenda client - NE RIEN ECRIRE "
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

Columns("B:B").Select
Selection.Locked = False
Selection.FormulaHidden = False

On Error Resume Next
Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Range("B2").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Application.ScreenUpdating = True
ActiveWorkbook.Save
End Sub

Amicalement,
Lionel,
 
Vote positif 0 Vote négatif
H

Herdet

Nous a quitté
Repose en paix
Re : Macro - exécution longue

Bonjour,

arthour973

Tu pourrais faire un essai en bloquant le calcul pendant la copie des formules avec un Application.Calculation = xlCalculationManual en tête et un Application.Calculation = xlCalculationAutomatic à la fin avant le Application.ScreenUpdating = True.

Cordialement
Robert
 
Vote positif 0 Vote négatif
Misange

Misange

XLDnaute Barbatruc
Re : Macro - exécution longue

Bonjour
En complément de l'indispensable xlcalculationmanual, surtout quand on supprime des lignes, comme indiqué par Herdet que je salue,
1) il est inutile de sélectionner pour copier coller
Ce lien n'existe plus
A peu près tous les select de ton code peuvent et doivent être supprimés pour gagner en efficacité.
2) il faut toujours éviter, surtout avec excel 2007 et + de travailler sur des colonnes entières. Définir des plages et travailler dessus. L'utilisation de tableaux excel (onglet accueil/style/mettre sous forme de tableau) est un outil puissant pour cela
Ce lien n'existe plus
3) sans voir le moindre exemple de ce que tu fais il est impossible de tester quoi que ce soit (relis bien la charte et les conseils qui y sont donnés)
 
Vote positif 0 Vote négatif
Misange

Misange

XLDnaute Barbatruc
Re : Macro - exécution longue

Encore une ou deux choses
ActiveCell.FormulaR1C1 = "Infos agenda client - NE RIEN ECRIRE "
ce n'est pas une formule :) donc
ActiveCell = "Infos agenda client - NE RIEN ECRIRE " suffit (mais ce n'est pas cela qui ralentit)

With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

Ceci suffit :
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
 
Vote positif 0 Vote négatif

Discussions similaires

M
  • Question
Microsoft 365 Macro VBA supprimer une colonne
Réponses
5
Affichages
111
marie3107
M
M
  • Question
Microsoft 365 Copier / coller avec mise en forme VBA
Réponses
0
Affichages
159
marie3107
M
F
  • Question
Microsoft 365 Poursuivre ou pas la macro
Réponses
2
Affichages
194
Francky79
F
Ghassen
  • Résolu(e)
XL 2019 Affichage plein écran
Réponses
2
Affichages
406
Ghassen
Ghassen
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
1 K
AtTheOne
AtTheOne
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
280
robpellan52
R
L
  • Question
XL 2016 Macro et suppressions de lignes
Réponses
9
Affichages
610
fanfan38
fanfan38
Y
  • Question
XL 2013 Macro positionnée dans le code d'un feuille
Réponses
10
Affichages
294
Dranreb
Dranreb
Usine à gaz
  • Résolu(e)
XL 2021 recherche supprimer les espaces '"si valeur cherchée est numérique" sinon NON
Réponses
7
Affichages
315
Usine à gaz
Usine à gaz
L
  • Question
XL 2021 Comment utiliser la colonne d'une adresse en Private Sub - svp ?
Réponses
3
Affichages
272
vgendron
vgendron

Membres actuellement en ligne

21 membres et 226 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 294
Messages
2 086 953
Membres
103 404
dernier inscrit
sultan87