Bonjour à tous,

Un grand classique : Je suis béotien en VB mais je me soigne...
Problématique du jour : Sur une base assez modeste dans une feuille intitulée "Indicateurs" comportant une liste d'indicateurs(original non?) , j'ai besoin de faire un collage spécial car je viens copier la cellule H9 comportant une formule et je souhaite recopier le résultat dans la cellule R9 puis je traite toutes les lignes.
J'ai donc fais une macro avec une boucle toute bête sauf que, pour des raisons que j'ignore, ma macro toute pourrie met 1'55" pour traiter 334 lignes soit 0,34 seconde par ligne...
Je soupçonne mes nombreux select et les paramètres de mon PasteSpecial mais je ne sais quel serait le code le plus rapide pour traiter cela.

Quelqu'un aurait il une méthode plus rapide

PS : l'idéal quand j'aurais réglé ce problème de vitesse serait que je puisse ajouter une barre de progression ...
Si quelqu'un, a un joli code tout propre, je suis preneur.

Merci à tous

Thierry


Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Sub MAJ_Nom_Activite_dans_Indicateurs()
'
' MAJ_Nom_Activite_dans_Indicateurs Macro
' Vient mettre à jour le nom de l'activité pour un indicateur donné dans la feuille
' Indicateurs 
 
'annulation de  l'actualisation graphique d'Excel 
    Application.ScreenUpdating = False
'Déclaration variables
    Dim Compteur As Integer
    Dim Lignes_traitées As Integer
    Dim NbLignes As Integer
 
'Initialisation variables
    Compteur = 0
    Lignes_traitées = 0
    NbLignes = 0
'Choix de la feuille active
    Worksheets("INDICATEURS").Select
'calcul nombre de lignes
     NbLignes = WorksheetFunction.CountA(Range("E:E")) 
' Positionnement sur première cellule
    Range("R9").Select
' Lancement de la boucle et du traitement
    For Compteur = 0 To NbLignes
        If ActiveCell <> "" Then
            ActiveCell.Offset(0, -10).Select
            Selection.Copy
            ActiveCell.Offset(0, 10).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, Transpose:=False
            Lignes_traitées = Lignes_traitées + 1
        End If
        ActiveCell.Offset(1, 0).Select
    Next Compteur
    msgbox "Cette routine a traité " & Lignes_traitées & " lignes"
End Sub