[VBA] Optimisation de code

**bat001** · 08/09/2012, 19h37

Bonjour,
Je suis novice en VBA, mais j'ai des bases en programmation.
Pour la mise en contexte, je souhaite prendre des données d'un onglet, et les transférer dans un autre onglet tout en les réorganisant.
J'ai créé une macro qui scan dans une plage voulu les données à copier, puis qui copie les cellules sélectionnées dans l'autre onglet.
De plus, lorsque je réexécute le code, les données ayant été déplacé lors de la première exécution sont toujours présentent, et celle de l'exécution actuelle s'y rajoute... je dois donc supprimer les données une par une avant chaque exécution.

Le problème que j'ai est que lorsque j'exécute le code, le temps d'exécution est d'au moins 30secondes...
Est ce que il y aurait moyen d'optimiser mon code pour gagner en temps d'exécution ???

Je ne sais pas si j'ai été bien claire, mais si quelqu'un arrive à me répondre merci d'avance !!!

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
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
 
Public Sub FindManagementPFS()
 
Dim Trouve As Range
Dim Adresse1 As String
Dim domaine As String
Dim ColonneCopie As Range
Dim MaLigne As Variant
Dim MaPlage As Range
Dim LaPlage As Range
 
    'On sélectionne la colonne domaine de la phase ciblée
    Set MaPlage = Range("PlageDomainePFS")
    'On sélectionne le domaine recherché
    domaine = "Management"
    'On associe le fait de trouver le domaine recherché à une variable
    Set Trouve = MaPlage.Find(domaine)
    'On initialise le compteur qui nous permettra d'insérer les lignes au bon endroit
    ComptMan = 0
 
    If Not Trouve Is Nothing Then
        Adresse1 = Trouve.Address
        Do
            'On sélectionne l'onglet source
            With Sheets("DS PFS")
                'On sélecionne les 3 cellules que l'on veut copier
                Set LaPlage = Application.Union(Cells(Trouve.Row, 3), Cells(Trouve.Row, 4), Cells(Trouve.Row, 6), Cells(Trouve.Row, 7))
                Range(LaPlage.Address).Copy
            End With
            'On sélectionne l'onglet de destination
 
            With Sheets("DS PFS-FS-DEF-C0-C1-C2-D").Range("PlageManMulti")
            'Sheets("DS PFS-FS-DEF-C0-C1-C2-D").Select
                MaLigne = .Address
                MaLigne = Range(MaLigne).Row
                'On décale la sélection
            End With
 
            Sheets("DS PFS-FS-DEF-C0-C1-C2-D").Select
            Sheets("DS PFS-FS-DEF-C0-C1-C2-D").Range("PlageManMulti").Offset(ComptMan).Select 'offset à incrémenter selon le nombre de passage ds la boucle
 
 
            ActiveSheet.Paste
            'On coche la phase où se déroule la tâche
            Sheets("DS PFS-FS-DEF-C0-C1-C2-D").Cells(MaLigne + ComptMan, 7).Value = "x"
 
            'On boucle pour supprimer les doublons lorsque l'on réexécute le programme
            While Sheets("DS PFS-FS-DEF-C0-C1-C2-D").Cells(MaLigne + ComptMan + 1, 3).Value <> "arc"
                Sheets("DS PFS-FS-DEF-C0-C1-C2-D").Rows(MaLigne + ComptMan + 1).Delete
            Wend
 
            'On ajoute une ligne où sera copier la tâche suivante
            Sheets("DS PFS-FS-DEF-C0-C1-C2-D").Cells(MaLigne + ComptMan + 1, 3).EntireRow.Insert Shift:=xlUp
            ComptMan = ComptMan + 1
            Set Trouve = MaPlage.FindNext(Trouve)
        Loop While StrComp(Adresse1, Trouve.Address) <> 0
    End If
 
End Sub