Bonjour à tous,
Voilà je suis débutant et j'ai besoin de votre aide SVP.
j’exécute une macro de clacul simple à partir d'une feuille source qui contient mes donnée et dont quelques cellules contiennent des formules, mais en exécutant cette macro les formule disparaissent
ci joint mon code :
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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
Sub calcul1()
'Macro calcul 
Dim nb_max_ligne As Integer
Dim nb_max_col As Integer
Dim i As Integer, j As Integer
Dim valeur As String
dim pr as String, cm as String
Dim pr1 As String, cm1 as String
Dim pr2 As String, cm2 as String
Dim colonne
Dim w_plage As Range, ws_plage As Range
Dim w_tab
Dim ws_tab
Dim w As Worksheet
Dim ws As Worksheet
Set ws = Worksheets("dépenses")     'feuille source de donnée ou les formule diparaissent 
Set w = Worksheets("calcul")          'feuille de destination ou se fait le calcul
Set ws_plage = ws.Range("A1:FB1000")
Set w_plage = w.Range("A1:GA11")
 
nb_max_col = Application.CountA(ws.Rows(2))    'compter le nombre des colonnes
nb_max_ligne = Application.CountA(ws.Columns(9))    'compter le nombre des lignes
Range(w.Range("A2").Offset(0, 1), w.Range("A2").End(xlToRight)).ClearContents               'Effacer les anciennes valeurs pour faire le calcul selon les nouvelles valeurs
Range(w.Range("A3").Offset(0, 1), w.Range("A3").End(xlToRight)).ClearContents              'Effacer les anciennes valeurs pour faire le calcul selon les nouvelles valeurs
Range(w.Range("A4").Offset(0, 1), w.Range("A4").End(xlToRight)).ClearContents
Range(w.Range("A5").Offset(0, 1), w.Range("A5").End(xlToRight)).ClearContents
Range(w.Range("A6").Offset(0, 1), w.Range("A6").End(xlToRight)).ClearContents
Range(w.Range("A7").Offset(0, 1), w.Range("A7").End(xlToRight)).ClearContents
Range(w.Range("A8").Offset(0, 1), w.Range("A8").End(xlToRight)).ClearContents
 
w_tab = w_plage
ws_tab = ws_plage
          For i = 3 To nb_max_ligne
valeur = ws_tab(i, 9)
pr1 = ws_tab(i - 1, 6)   'Se positionner sur la colonne produit pour lire la valeur dedans 
pr2 = ws_tab(i - 2, 6)   'Se positionner sur la colonne produit pour lire la valeur dedans
pr = ws_tab(i, 6)
cm = ws_tab(i, 1)                               'lire la valeur dans la colonne commerçant
cm1 = ws_tab(i - 1, 1)
cm2 = ws_tab(i - 2, 1)
 
    For j = 10 To nb_max_col
 
    If valeur = "estimation" And pr = UserForm1.choix_produit And cm = UserForm1.choix_commercant Then
 
    w_tab(2, j - 8) = w_tab(2, j - 8) + ws_tab(i, j)
    End If
 
    If valeur = "réel" And pr1 = UserForm1.choix_produit And cm1 = UserForm1.choix_commercant Then
 
 
     w_tab(4, j - 8) = w_tab(4, j - 8) + ws_tab(i, j)     'Calcul valeurs estimation
    End If
 
    If valeur = "Reste" And pr2 = UserForm1.choix_produit And cm2 = UserForm1.choix_commercant Then
 
     w_tab(6, j - 8) = w_tab(6, j - 8) + ws_tab(i, j)           'Calcul Valeurs réel
 
    End If
    w_tab(3, 2) = w_tab(2, 2)
    w_tab(3, j - 7) = w_tab(3, j - 8) + w_tab(2, j - 7) 'calcul cummulé estimation
 
    w_tab(5, 2) = w_tab(4, 2)
    w_tab(5, j - 7) = w_tab(5, j - 8) + w_tab(4, j - 7)   ' calcul  cumulé reel
 
    w_tab(7, 2) = w_tab(6, 2)
    w_tab(7, j - 7) = w_tab(7, j - 8) + w_tab(6, j - 7)    'calcul cumulé reste
 
    If w_tab(4, j - 8) <> 0 Then             
w_tab(8, j - 8) = w_tab(6, j - 8) / w_tab(4, j - 8)
Else: w_tab(8, j - 8) = 0
End If
    Next j
 
 
 
 Next i
 
 
 
w_plage = w_tab
ws_plage = ws_tab
 
Set w = Nothing
Set ws = Nothing
End Sub

je suis sur que la manipulation ws_plage=ws.range("A1:FB1000")
ws_tab=ws_plage et à la fin ws_plage=ws_tab me fait perdre mes formules de calcul mais je l'utilise pour optimiser le temps de calcul.
Est-ce que vous avez quelque chose à proposer pour résoudre ce problème SVP
Merci d'avance