Bonjour

j'ai une macro qui fonctionne pour 5000 lignes en un temps correct (environ 20 min)

cependant au passage a plus de 6500 lignes, ca n'est plus supportable (temps supérieur à 15 heures !!!)

à quoi cela peut il être dû ?

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
 
Option Explicit
 
Dim WsDo    As Worksheet
Dim WsBs    As Worksheet
Dim WsLs    As Worksheet
 
Sub RemplacerCaracteres()
    Dim Cell        As Range
    Dim LigLs       As Long
 
    If ActiveSheet.Cells(1, 1).Value <> "IRN" Then
        MsgBox "Vous n'étes pas dans la bonne feuille pour lancer l'application"
        Exit Sub
    End If
    Worksheets.Add after:=Worksheets(1)
 
    On Error Resume Next
    ActiveSheet.Name = "Base"
    If Err > 0 Then
        MsgBox "La feuille Base existe déjà"
        Exit Sub
        On Error GoTo 0
    End If
    On Error GoTo 0
 
    Set WsDo = ActiveWorkbook.Worksheets(1)
    Set WsBs = ActiveWorkbook.Worksheets("Base")
    Set WsLs = ThisWorkbook.Worksheets("Liste")
 
    WsDo.Activate
    WsDo.Cells.Select
    Selection.Copy Destination:=WsBs.Cells(1, 1)
    WsBs.Columns.AutoFit
 
    WsBs.Activate
    Cells(1, 1).Select
    Cells.SpecialCells(xlCellTypeConstants, 23).Select
    LigLs = 2
    While WsLs.Cells(LigLs, 1) <> ""
        For Each Cell In Selection
            If Not IsError(Cell.Value) Then
                Cell.Value = Replace(Cell.Value, _
                                     WsLs.Cells(LigLs, 1).Value, _
                                     WsLs.Cells(LigLs, 2).Value)
            End If
        Next
        Application.StatusBar = " n° de ligne " & LigLs
        LigLs = LigLs + 1
    Wend
 
    MsgBox "Terminé"
    Application.StatusBar = False
End Sub