[XL-2010] macro calcul entre deux TCD

Bonjour tout le monde

ça fait un moment que je poste le même sujet mais sans réponse donc je vais mettre un peu de code en ésperant que ca parlera un peu plus .

en gros a partir de deux tableaux d'orgine je crée deux tableaux croisée dynamique que je souhaiterais croisé en dernier ...
c'est la ou se pose mon blocage car les deux tableaux on des lignes et colonnes différentes donc je dois faire une sorte d'union des deux tableaux concernant les colonnes et regroupement par ligne.

je pense que c'est pas facile a voir du premier coup.

je sais comment regrouper mais pour des colonnes statique et qui on ont les mêmes entêtes ; la je dois faire corréspondre les entêtes avant de commencer le regroupement.

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
Sub TCD()    
    Dim WSD, WSC As Worksheet
    Dim PTCache As PivotCache
    Dim PT As PivotTable
    Dim PRange As Range
    Dim FinalRow As Long
    Dim FinalCol As Long
    Set WSO = Worksheets(1)
    Set WSD = Worksheets(3)
    Set WSF = Worksheets(4)
    For Each PT In WSD.PivotTables
        PT.TableRange2.Clear
    Next PT
    FinalRow = WSO.Cells(Application.Rows.Count, 1).End(xlUp).Row
    FinalCol = WSO.Cells(1, Application.Columns.Count). _
        End(xlToLeft).Column
    Set PRange = WSO.Cells(1, 1).Resize(FinalRow, FinalCol)
    Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:= _
        xlDatabase, SourceData:=PRange)
    Set PT = PTCache.CreatePivotTable(TableDestination:=WSD. _
        Cells(2, FinalCol + 2), TableName:="PivotTable1")
    PT.ManualUpdate = True
    PT.AddFields RowFields:="CODE ARTICLE", ColumnFields:="ANNEE MOIS"
    With PT.PivotFields("Qte_dem_km")
        .Orientation = xlDataField
        .Function = xlSum
        .Position = 1
    End With
    With PT
        .ColumnGrand = False
        .RowGrand = False
        .NullString = "0"
    End With
    PT.ManualUpdate = False
    PT.ManualUpdate = True
    PT.TableRange2.Offset(1, 0).Copy
 
WSD.Cells(5 + PT.TableRange2.Rows.Count, FinalCol + 2). _
        PasteSpecial xlPasteValues
PT.TableRange2.Offset(1, 0).Copy
WSF.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
PT.TableRange2.Clear
Set PTCache = Nothing
    'PT.TableRange2.Clear
    Set PTCache = Nothing
Call TCP
End Sub
 
Sub TCP()
    Dim WSD, WSC As Worksheet
    Dim PTCache As PivotCache
    Dim PT As PivotTable
    Dim PRange As Range
    Dim FinalRow As Long
    Dim FinalCol As Long
    Set WSO = Worksheets(2)
    Set WSD = Worksheets(3)
    Set WSF = Worksheets(5)
    For Each PT In WSD.PivotTables
        PT.TableRange2.Clear
    Next PT
    FinalRow = WSO.Cells(Application.Rows.Count, 1).End(xlUp).Row
    FinalCol = WSO.Cells(1, Application.Columns.Count). _
        End(xlToLeft).Column
    Set PRange = WSO.Cells(1, 1).Resize(FinalRow, FinalCol)
    Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:= _
        xlDatabase, SourceData:=PRange)
    Set PT = PTCache.CreatePivotTable(TableDestination:=WSD. _
        Cells(2, FinalCol + 2), TableName:="PivotTable1")
    PT.ManualUpdate = True
    PT.AddFields RowFields:="ARTICLE", ColumnFields:="ANNEE MOIS"
 
    With PT.PivotFields("Qté restant à livrer")
        .Orientation = xlDataField
        .Function = xlSum
        .Position = 1
    End With
 
    With PT
        .ColumnGrand = False
        .RowGrand = False
        .NullString = "0"
    End With
    PT.ManualUpdate = False
    PT.ManualUpdate = True
    PT.TableRange2.Offset(1, 0).Copy
 
WSD.Cells(5 + PT.TableRange2.Rows.Count, FinalCol + 2). _
        PasteSpecial xlPasteValues
PT.TableRange2.Offset(1, 0).Copy
WSF.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
PT.TableRange2.Clear
Set PTCache = Nothing
    'PT.TableRange2.Clear
    Set PTCache = Nothing
End Sub

merci :)