Lecture données tableau croisé dynamique

Bonjour,

je suis débutante en VBA et c'est la première fois que je consulte ce forum.

En fait, j'ai un souci avce un tableau croisé dynamique.

J'ai un premier fichier qui contient des numéros de contrats puis une autre base contenant des informations relatives à ces diiférents numéros de contrats.
J'ai crée un tableau croisé dynamique afin de mieux présenter les données.

A chaque nouveau numéro de contrat, un tableau croisé dynamique est généré avec la propriété Current Page.
En fait, je lis les numéros de contrat à partir d'une première feuille, puis je fais une copie en valeur pour chercher ce numéro de contrat dans le tableau croisé dynamique et enfin je recopie les données propres à ce numéro de contrat dans une autre feuille.
J'ai crée une boucle qui lit tous les numéros de contrats et qui exécute tout ceci à la suite.

J'ai deux soucis:

-quand je relance plusieurs fois la boucle, ce ne sont jamais les mêmes données correspondant à un numéro de contrat qui ressortent;

-le tableau croisé dynamique se retrouve affecté car il ne fournit plus les bonnes données (j'ai vérifié ceci en créant un tableau croisé dynamique indépendant).

Je vous donne les lignes de code du programme:

Code:

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
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
Sub alim_Pyer_cotisations2()
 
Dim ws(8) As Worksheet
Dim rpp, garantie, survenance As String
Dim i As Integer
 
For i = 6 To 16 'boucle sur l'ensemble des numéros de contrat et va chercher le montant des primes dans le tableau croisé dynamique'
Set ws(1) = ThisWorkbook.Worksheets("cotsin")
Set ws(2) = ThisWorkbook.Worksheets("cotisations2006")
ws(2).Cells(2, 2).Value = ws(1).Cells(i, 1).Value
Sheets("cotisations2006").Select
rpp = Range("cotisations2006!b2").Value
survenance = Range("cotisations2006!b3").Value
 ActiveSheet.PivotTables("Primes").PivotFields("N° Rpp").CurrentPage = rpp
'ActiveSheet.PivotTables("Primes").PivotFields("Année Survenance").CurrentPage = survenance
 
 'remplissage de la base globale COT-SIN garantie par garantie et détail du type de prime'
 
'garantie décès'
 
    If ws(2).Cells(10, 3).Value <> "" Then
      ws(1).Cells(i, 2).Value = ws(2).Cells(10, 3).Value
      ws(1).Cells(i, 10).Value = "Primes définitives"
    ElseIf (ws(2).Cells(10, 2).Value > 0 Or ws(2).Cells(10, 4).Value > 0) Then
      ws(1).Cells(i, 2).Value = Application.WorksheetFunction.Max(ws(2).Cells(10, 2).Value, ws(2).Cells(10, 4).Value)
      If ws(2).Cells(10, 2).Value < ws(1).Cells(10, 4).Value Then
        ws(1).Cells(i, 10).Value = "Primes Provisoires"
      Else
        ws(1).Cells(i, 10).Value = "encaissements"
      End If
      End If
 
 
'garantie décès accidentel'
 
    If ws(2).Cells(11, 3).Value <> "" Then
    ws(1).Cells(i, 8).Value = ws(2).Cells(11, 3).Value
    ws(1).Cells(i, 16).Value = "Primes définitives"
    ElseIf (ws(2).Cells(11, 2).Value > 0 Or ws(2).Cells(11, 4).Value > 0) Then
        ws(1).Cells(i, 8).Value = Application.WorksheetFunction.Max(ws(2).Cells(11, 2).Value, ws(2).Cells(11, 4).Value)
        If ws(2).Cells(11, 2).Value < ws(1).Cells(11, 4).Value Then
        ws(1).Cells(i, 16).Value = "Primes Provisoires"
      Else
        ws(1).Cells(i, 16).Value = "encaissements"
      End If
    End If
 
 
'garantie rente de conjoint'
 
    If ws(2).Cells(16, 3).Value <> "" Then
    ws(1).Cells(i, 4).Value = ws(2).Cells(16, 3).Value
    ws(1).Cells(i, 12).Value = "Primes définitives"
        ElseIf (ws(2).Cells(16, 2).Value > 0 Or ws(2).Cells(16, 4).Value > 0) Then
        ws(1).Cells(i, 4).Value = Application.WorksheetFunction.Max(ws(2).Cells(16, 2).Value, ws(2).Cells(16, 4).Value)
        If ws(2).Cells(16, 2).Value < ws(1).Cells(16, 4).Value Then
        ws(1).Cells(i, 12).Value = "Primes Provisoires"
      Else
        ws(1).Cells(i, 12).Value = "encaissements"
      End If
    End If
 
'garantie rente éducation'
 
    If ws(2).Cells(17, 3).Value <> "" Then
    ws(1).Cells(i, 3).Value = ws(2).Cells(17, 3).Value
    ws(1).Cells(i, 11).Value = "Primes définitives"
    ElseIf (ws(2).Cells(17, 2).Value > 0 Or ws(2).Cells(17, 4).Value > 0) Then
    ws(1).Cells(i, 3).Value = Application.WorksheetFunction.Max(ws(2).Cells(17, 2).Value, ws(2).Cells(17, 4).Value)
        If ws(2).Cells(16, 2).Value < ws(1).Cells(17, 4).Value Then
        ws(1).Cells(i, 11).Value = "Primes Provisoires"
      Else
        ws(1).Cells(i, 11).Value = "encaissements"
      End If
      End If
 
 
  '  garantie RF '
 
    If ws(2).Cells(18, 3).Value <> "" Then
    ws(1).Cells(i, 7).Value = ws(2).Cells(18, 3).Value
    ws(1).Cells(i, 15).Value = "Primes définitives"
    ElseIf (ws(2).Cells(18, 2).Value > 0 Or ws(2).Cells(18, 4).Value > 0) Then
    ws(1).Cells(i, 7).Value = Application.WorksheetFunction.Max(ws(2).Cells(18, 2).Value, ws(2).Cells(18, 4).Value)
        If ws(2).Cells(18, 2).Value < ws(1).Cells(18, 4).Value Then
        ws(1).Cells(i, 15).Value = "Primes Provisoires"
      Else
        ws(1).Cells(i, 15).Value = "encaissements"
      End If
      End If
 
  'garantie  "Incapacité Temporaire"
 
    If ws(2).Cells(12, 3).Value <> "" Then
    ws(1).Cells(i, 5).Value = ws(2).Cells(12, 3).Value
    ws(1).Cells(i, 13).Value = "Primes définitives"
    ElseIf (ws(2).Cells(12, 2).Value > 0 Or ws(2).Cells(12, 4).Value > 0) Then
    ws(1).Cells(i, 5).Value = Application.WorksheetFunction.Max(ws(2).Cells(12, 2).Value, ws(2).Cells(12, 4).Value)
         If ws(2).Cells(12, 2).Value < ws(1).Cells(12, 4).Value Then
        ws(1).Cells(i, 13).Value = "Primes Provisoires"
      Else
        ws(1).Cells(i, 13).Value = "encaissements"
      End If
      End If
 
  ' garantie "Invalidité Permanente"'
 
    If ws(2).Cells(13, 3).Value <> "" Then
    ws(1).Cells(i, 6).Value = ws(2).Cells(13, 3).Value
    ws(1).Cells(i, 14).Value = "Primes définitives"
    ElseIf (ws(2).Cells(13, 2).Value > 0 Or ws(2).Cells(13, 4).Value > 0) Then
    ws(1).Cells(i, 6).Value = Application.WorksheetFunction.Max(ws(2).Cells(13, 2).Value, ws(2).Cells(13, 4).Value)
       If ws(2).Cells(13, 2).Value < ws(1).Cells(13, 4).Value Then
        ws(1).Cells(i, 14).Value = "Primes Provisoires"
      Else
        ws(1).Cells(i, 14).Value = "encaissements"
      End If
      End If
 
Next i
 
End Sub

J'espère que j'ai été assez claire dans mes explications et je vous remercie par avance pour votre aide.

Jackeline