Optimisation d'un VBA

Bonjour,

je me retrouve avec un VBA que je pense un peu trop compliqué, quelqu'un pourai me dire comment l'obtimiser et du coup le rendre plus simple ?

Private Sub CommandButton1_Click()

Selection.Interior.ColorIndex = 4

Workbooks("ecran.xlsm").Sheets("feuil1").Range("a6:c26").Copy Workbooks("lafeuille.xlsm").Worksheets("feuil1").Range("a6")

Workbooks("ecran.xlsm").Sheets("feuil1").Range("ac6:ae31").Copy Workbooks("lafeuille.xlsm").Worksheets("feuil1").Range("ac6")

Workbooks("ecran.xlsm").Sheets("feuil1").Range("e6:j19").Copy Workbooks("lafeuille.xlsm").Worksheets("feuil1").Range("e6")

Workbooks("ecran.xlsm").Sheets("feuil1").Range("v6:aa9").Copy Workbooks("lafeuille.xlsm").Worksheets("feuil1").Range("v6")

Workbooks("ecran.xlsm").Sheets("feuil1").Range("v13:aa19").Copy Workbooks("lafeuille.xlsm").Worksheets("feuil1").Range("v13")

Workbooks("ecran.xlsm").Sheets("feuil1").Range("v23:aa26").Copy Workbooks("lafeuille.xlsm").Worksheets("feuil1").Range("v23")

Workbooks("ecran.xlsm").Sheets("feuil1").Range("p30:aa31").Copy Workbooks("lafeuille.xlsm").Worksheets("feuil1").Range("p30")

Workbooks("ecran.xlsm").Sheets("feuil1").Range("p23:p26").Copy Workbooks("lafeuille.xlsm").Worksheets("feuil1").Range("p23")

Workbooks("ecran.xlsm").Sheets("feuil1").Range("l6:n19").Copy Workbooks("lafeuille.xlsm").Worksheets("feuil1").Range("l6")

Workbooks("ecran.xlsm").Sheets("feuil1").Range("r6:t9").Copy Workbooks("lafeuille.xlsm").Worksheets("feuil1").Range("r6")

Workbooks("ecran.xlsm").Sheets("feuil1").Range("r13:t19").Copy Workbooks("lafeuille.xlsm").Worksheets("feuil1").Range("r13")

Workbooks("ecran.xlsm").Sheets("feuil1").Range("r23:t26").Copy Workbooks("lafeuille.xlsm").Worksheets("feuil1").Range("r23")

Workbooks("ecran.xlsm").Sheets("feuil1").Range("p6:p19").Copy Workbooks("lafeuille.xlsm").Worksheets("feuil1").Range("p6")

Workbooks("lafeuille.xlsm").Activate

ActiveWorkbook.Save

Workbooks("ecran.xlsm").Activate

Unload Me

End Sub

Merci

Bonsoir,

une possibilité

Private Sub CommandButton1_Click()
    rtc = Split("A6:C26,AC6:AE31,E6:J19,V6:AA9,V13:AA19,V23:AA26,P30:AA31,P23:P26,l6:N19,R6:T9,R13:T19,R23:T26,P6:P19", ",")
    Selection.Interior.ColorIndex = 4
    For i = 0 To UBound(rtc)
        d = Split(rtc(i), ":")(1)
        Workbooks("ecran.xlsm").Sheets("feuil1").Range(rtc(i)).Copy Workbooks("lafeuille.xlsm").Worksheets("feuil1").Range(d)
    Next i
    Workbooks("lafeuille.xlsm").Activate
    ActiveWorkbook.Save
    Workbooks("ecran.xlsm").Activate
    Unload Me
End Sub

Bonsoir,

C'est un peu lourd en effet !

1re étape: faire disparaître les Selection, Select, Activate...

Pour le Selection qui débute la macro, il faut savoir ce qu'est cette sélection et où elle se trouve ?

Il faut sans doute savoir aussi pourquoi il y a une sélection sur laquelle on s'appuie si l'on veut faire autrement.

Pour la fin ça va être :

    Workbooks("lafeuille.xlsm").Save

Mais pourquoi le laisser ouvert après sauvegarde si l'on a fini la copie ? Autant le fermer non ?

Alors, sauf raison contraire :

    Workbooks("lafeuille.xlsm").Close True
    Unload Me

ecran.xlsm sera ainsi actif sans qu'on ait à le faire.

2e étape: on reviendra sur la sélection initiale lorsque connue, mais étape sur les couleurs : dès lors que l'on travaille sur Excel 2007 ou version ultérieure, le système de couleurs n'est plus limité aux 56 couleurs de la palette, on affiche désormais toutes les couleurs définies sur 16 bits, un progrès qu'il serait malséant de récuser. Alors oublions ColorIndex, dont l'intérêt se limite désormais à xlColorIndexAutomatic et xlColorIndexNone, pour se tourner vers la propriété Color.

Avec laquelle on définira toute couleur au moyen de la fonction RGB... Au cas particulier, on colore en vert, une des 8 couleurs de base pour laquelle une constante VBA existe, qu'on peut donc utiliser :

    ???.Interior.Color = vbGreen

3e étape: on s'attaque au corps principal, répétition interminable de

Workbooks("ecran.xlsm").Sheets("feuil1")

. On va l'éliminer en mettant la feuille sous instruction With:

    With Workbooks("ecran.xlsm").Worksheets("Feuil1")
        .Range("A6:C26").Copy....

On n'aura plus à le répéter, et plus qu'une cerise sur le gâteau, l'exécution en sera plus rapide !

4e étape: il nous reste la répétition équivalente de Workbooks("lafeuille.xlsm").Worksheets("feuil1").

Cette feuille n'étant pas un objet enfant de celle mise sous With ci-dessus on ne peut la traiter pareillement mais on va l'affecter à une variable :

Private Sub CommandButton1_Click()
    Dim wsC As Worksheet

    Set wsC = Workbooks("lafeuille.xlsm").Worksheets("Feuil1")
    With Workbooks("ecran.xlsm").Sheets("Feuil1")
        .Range("A6:C26").Copy wsC.Range("A6")
        '...
    End With
    '...

Ça raccourcit les lignes de code, et l'accès à une variable est plus rapide qu'à l'objet lui-même. On a déjà un gain assuré.

5e étape: Sauf cas particulier (à examiner alors de plus près), on a rarement intérêt à faire du copier-coller, lent.

Il faut lui préférer un transfert direct de valeurs, ce qu'on ne peut faire qu'en VBA (et pas en manuel). On rétablit ensuite, s'il y a lieu la mise en forme. Il n'y a que si des formules doivent être conservées, et une mise en forme complexe et longue, que le copier-coller peut redevenir intéressant, mais ces cas sont rares.

On va donc affecter directement les valeurs des plages sources aux plages cibles:

       wsC.Range("A6:C26").Value = .Range("A6:C26").Value

6e étape: Mais il nous reste à répéter ça pour toutes les plages... ! Une répétition qu'on ne peut éliminer que par une boucle. Mais il n'y a pas régularités dans ces plages, comment faire alors pour pouvoir réaliser une boucle ?

On forme un tableau listant les éléments ciblés et on parcourt ce tableau :

Private Sub CommandButton1_Click()
    Dim wsC As Worksheet, Plg, i%
    xxxxx.Interior.Color = vbGreen
    Set wsC = Workbooks("lafeuille.xlsm").Worksheets("Feuil1")
    Plg = Split("A6:C26 E6J19 L6:N19 P6:P19 R6:T9 V6:AA9 AC6:AE31 R13:T19 V13:AA19 P23:P26" _
     & " R23:T26 V23:AA26 P30:AA31")
    With Workbooks("ecran.xlsm").Sheets("Feuil1")
        For i = 0 To UBound(Plg)
            wsC.Range(Plg(i)).Value = .Range(Plg(i)).Value
        Next i
    End With
    Workbooks("lafeuille.xlsm").Close True
    Unload Me
 End Sub

Ajoutons pour finir (en attendant l'éclaircissement de la sélection initiale) qu'il convient de placer le code cité dans un post sous balises Code </>, ainsi que je l'ai fait. Et qu'il convient d'indenter le code pour faciliter le travail... ce que je ne considère pas comme une option !

Cordialement.