Rebonjour,

En cette belle journée,
Deux problemes sont nés,
Le premier fut résolu,
Quand le second fut perçu,
Le temps n'était plus allié,
Je m'y casse le nez,
Sur des secondes en années,
Et un cerveau en chantier.

(Chui nul en pseudo-poésie...)

Bref, j'ai un code qui traite une quantité énorme de lignes, en fait, elles se repartissent meme en deux feuilles, la premiere ne suffisant pas (en conclusion prés de 66000 lignes de tableau).

Je dois faire plusieurs choses sur ce tableau, en vue de construire un méga Tableau croisé dynamique.

Il me faut

pour chaque feuille
- Nommer les colonnes,

Pour chaque ligne (de chaque feuille)
- La supprimer si elle répond a certaines conditions
- Renommer une cellule
- Créer une nouvelle colonne
- Signer certains montants selon sa classe comptable.
- Inserer dans la colonne nouvellement créée une formule indigeste (qu'on m'a d'ailleurs, gentillement aidé à insérer)

End
End

- Trier

Le code donne ca :

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
60
61
62
For i = 1 To Worksheets.count 
    'Interface d'execution de la preparation avant création
    Worksheets(i).Select
    Cells.Select
    Range("BE7").Activate
    Range("BN1") = "PRCTRUBR"
    Selection.CreateNames Top:=True, Left:=False, Bottom:=False, Right:= _
        False
 
    NbLignes = ActiveSheet.UsedRange.Rows.Count
 
 
    'Ligne par ligne
    For j = 2 To NbLignes
        'Supprime les contrats avec le préfixe "W", "X", "Y" ou "Z"
        'Supprime les Rubriques comprises dans l'intervalle [201;399]
 
        If Mid(Cells(j, 8).Value, 1, 1) = "W" Or Mid(Cells(j, 8).Value, 1, 1) = "X" Or Mid(Cells(j, 8).Value, 1, 1) = "Y" Or Mid(Cells(j, 8).Value, 1, 1) = "Z" Then
            Rows(j).Delete
        End If
 
        If Cells(j, 13) >= 201 And Cells(j, 13) <= 399 Then
            Rows(j).Delete
        End If
 
        'Change les noms de contrats qui n'ont pas "A" comme préfixe.
        If Cells(j, 8).Value <> "" Then
            Cells(j, 8).Value = "A" & Mid(Cells(j, 8).Value, 2, 4)
        End If
 
        'Signe le montant pour obtenir un solde juste
        classe = Mid(Cells(j, 7), 1, 1)
 
        If classe = "6" Then
            If Cells(j, 18).Value = "C" Then
                Cells(j, 50).Value = Cells(j, 50).Value * -1
            End If
        End If
 
        If classe = "4" Or classe = "7" Then
            If Cells(j, 18).Value = "D" Then
                Cells(j, 50).Value = Cells(j, 50).Value * -1
            End If
        End If
 
 
 
        'Insertion colonne avec formule pour calcul de % par Rubrique
        StrFormula = "=SI(SOMMEPROD(($M$1:M" & j - 1 & "=M" & j & ")*(T$1:T" & j - 1 & "=T" & j & "))=0;SOMMEPROD(($M$2:$M$" & NbLignes & "=M" & j & ")*($T$2:$T$" & NbLignes & "=T" & j & ");$AX$2:$AX$" & NbLignes & ")/SOMME.SI($M$2:$M$" & NbLignes & ";M" & j & ";$AX$2:$AX$" & NbLignes & ");" & Chr(34) & Chr(34) & ")"
        Cells(j, 66).FormulaLocal = StrFormula
 
    Next
 
            'Tri
        Cells.Select
        Selection.Sort Key1:=Range("H2"), Order1:=xlAscending, Key2:=Range("M2") _
        , Order2:=xlAscending, Key3:=Range("T2"), Order3:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
        xlSortNormal
 
Next

Mais au lancement, mon ordi plante, car le temps d'execution est clairement trop loooooooong.

Si certains ont l'ame bricoleur, peuvent-il m'aider à accelerer le traitement, et le rendre le moins lourd possible ? Ma maitrise du VBA est trop faible pour y remedier seul.