Bonjour à tous,

J'ai ecrit le ptit bout de code suivant...Il est appellé via une procédure "Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)"
...
Feuille1 et Feuille2 contiennent environ 1000 lignes, du coup la moindre modification prend des plombes sur mon vieux coucou!

Auriez vous quelques conseils, avis ou idée pour améliorer cela! Optimiser en quelque sorte?

lastline_FeuilleX, X=[1,2], est la dernière ligne remplie de la feuille FeuilleX

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
For i = 3 To lastline_Feuille1
            For j = 3 To lastline_Feuille2
            If Sheets("Feuille1").Range("A" & i) = Sheets("Feuille2").Range("A" & j) Then
                If Sheets("Feuille1").Range("B" & i) = Sheets("Feuille2").Range("B" & j) Then
                    For k = 3 To lastline_Feuille2
                    If (Sheets("Feuille1").Range("K" & i) = Sheets("Feuille2").Range("E" & k)) Then
                        Bool = 1
                        Exit For
                    Else
                        Bool = 0
                    End If
                    Next
                    If Bool = 0 Then
                        Sheets("Feuille1").Select
                        Sheets("Feuille1").Rows(i).Select
                        Selection.Copy
                        ' Copie de la ligne depuis la feuille Cobol
                        Sheets("Feuille2").Select
                        Rows(i).Select
                        Selection.Insert Shift:=xlDown
                        ' Insertion de la ligne dans Feuille2
                        j = lastline_Feuille2
                        ' Sortie de la boucle 2
                        Range("C" & i).Select
                        Application.CutCopyMode = False
                        Selection.Delete Shift:=xlToLeft
                        Range("C" & i).Select
                        Application.CutCopyMode = False
                        Selection.Delete Shift:=xlToLeft
                        Range("E" & i).Select
                        Application.CutCopyMode = False
                        Selection.Delete Shift:=xlToLeft
                        Range("E" & i).Select
                        Application.CutCopyMode = False
                        Selection.Delete Shift:=xlToLeft
                        Range("E" & i).Select
                        Application.CutCopyMode = False
                        Selection.Delete Shift:=xlToLeft
                        Range("E" & i).Select
                        Application.CutCopyMode = False
                        Selection.Delete Shift:=xlToLeft
                        End If
                    End If
                    Exit For
                    End If
            Next
Next
D'avance merci!
Bonne fin d'a-m

Ted