Excal 2010 - Faciliter l'exécution d'une macro [Résolu/Fermé]

Signaler
-
 Alwys -
Bonjour à tous,

J'ai une macro qui serre à extraire des informations d'une feuille excel pour le coller dans une autre feuille. La macro met 10 -15 seconds à s'exécuter (pas embêtant en soi) mais elle fige aussi le classeur excel (le message '... ne reponds pas...' apparaît dans la barre de titre.

A-t-il quelque chose que je puisse modifier pour éviter ce problème?

Merci d'avance



Mon code:

Sub Accidents1()

With Excel.Application
.ScreenUpdating = False
.Calculation = Excel.xlCalculationManual
.EnableEvents = False
End With


On Error Resume Next

Dim rng As Range
Dim lastRow As Long
Dim cell As Variant
Dim count As Long
count = 1
count1 = 1
count2 = 1
count3 = 1

With Sheets("WR - Action Plan")


Set rng = .Range("C:C")


For Each cell In rng
If cell.Value = Sheets("WR - Accident Register").Range("N4").Value And cell.Offset(0, 3).Value = "Accident" Then

Range(cell.Offset(0, 8), cell.Offset(0, 10)).Copy


Sheets("WR - Accident Register").Activate
Range("G22", "I22").End(xlUp).Offset(count, 0).PasteSpecial


Sheets("WR - Action Plan").Activate





Range(cell.Offset(0, -1), cell.Offset(0, 1)).Copy


Sheets("WR - Accident Register").Activate
Range("B22", "D22").End(xlUp).Offset(count1, 0).PasteSpecial

Sheets("WR - Action Plan").Activate



Range(cell.Offset(0, 4), cell.Offset(0, 5)).Copy


Sheets("WR - Accident Register").Activate
Range("E22", "F22").End(xlUp).Offset(count2, 0).PasteSpecial


Sheets("WR - Action Plan").Activate



Range(cell.Offset(0, 19), cell.Offset(0, 19)).Copy


Sheets("WR - Accident Register").Activate
Range("Q22", "R22").End(xlUp).Offset(count3, 0).PasteSpecial


Sheets("WR - Action Plan").Activate


End If
Next
End With

With Excel.Application
.ScreenUpdating = True
.Calculation = Excel.xlAutomatic
.EnableEvents = True
End With


End Sub

1 réponse

Messages postés
12251
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
17 mars 2021
2 594
Bonjour,

Plutôt que de boucler sur toute la colonne
Set rng = .Range("C:C")
, limitez vous aux cellules contenant des données :

 Set rng = .Range("C1:C" & .Range("C" & Rows.Count).End(xlUp).Row)
--
Cordialement,
Franck
ça marche parfaitement! Merci Beaucoup!!