Importation de données issues d'un fichier en TDC vers un autre document excel

Version imprimable

Je souhaite importer des données d'un tableau croisé dynamique vers un autre document excel.

J'utilise ce code (qui marche lorsque les données ne sont pas issues d'un TCD) :

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
Sub Importer()
 
    Dim Chemin As String, Fichier As String, Fichier2 As String
 
    '
    Dim wkb As Workbook
    Dim shFrom As Worksheet
    Dim shTo As Worksheet
    Dim varTab As Variant
    '
    '
    Chemin = ThisWorkbook.Path & Application.PathSeparator
    Fichier = Dir("C:\Users\fetcheberry\Desktop\Répartition actifs.xlsx")
 
    ' pointeurs
    Set wkb = Workbooks.Open(Chemin & Fichier)
    Set shFrom = wkb.Worksheets("TCD Actifs")
    Set shTo = ThisWorkbook.Worksheets("Répartition")
 
    Application.ScreenUpdating = False
 
'    With Workbooks.Open(Chemin & Fichier)
'    Range("A2").Select
'    Range(Selection, Selection.End(xlDown)).Select
'    Range(Selection, Selection.End(xlToRight)).Select
'    Selection.Copy
'    ThisWorkbook.ActiveSheet.Range("K1").PasteSpecial Paste:=xlPasteValues
'    .Close savechanges:=False
'    End With
 
    varTab = shFrom.Range(shFrom.Range("A2"), shFrom.Range("A2").End(xlDown))
    shTo.Range("A1").Resize(UBound(varTab), UBound(varTab, 2)) = varTab
 
    varTab = shFrom.Range(shFrom.Range("B2"), shFrom.Range("B2").End(xlDown))
    shTo.Range("B1").Resize(UBound(varTab), UBound(varTab, 2)) = varTab
 
    varTab = shFrom.Range(shFrom.Range("C2"), shFrom.Range("C2").End(xlDown))
    shTo.Range("C1").Resize(UBound(varTab), UBound(varTab, 2)) = varTab
 
varTab = shFrom.Range(shFrom.Range("D2"), shFrom.Range("D2").End(xlDown))
    shTo.Range("D1").Resize(UBound(varTab), UBound(varTab, 2)) = varTab
 
   varTab = shFrom.Range(shFrom.Range("E2"), shFrom.Range("E2").End(xlDown))
    shTo.Range("E1").Resize(UBound(varTab), UBound(varTab, 2)) = varTab
 
    varTab = shFrom.Range(shFrom.Range("F2"), shFrom.Range("F2").End(xlDown))
    shTo.Range("F1").Resize(UBound(varTab), UBound(varTab, 2)) = varTab
 
    varTab = shFrom.Range(shFrom.Range("G2"), shFrom.Range("G2").End(xlDown))
    shTo.Range("G1").Resize(UBound(varTab), UBound(varTab, 2)) = varTab
 
    varTab = shFrom.Range(shFrom.Range("H2"), shFrom.Range("H2").End(xlDown))
    shTo.Range("H1").Resize(UBound(varTab), UBound(varTab, 2)) = varTab
 
    varTab = shFrom.Range(shFrom.Range("I2"), shFrom.Range("I2").End(xlDown))
    shTo.Range("I1").Resize(UBound(varTab), UBound(varTab, 2)) = varTab
 
    varTab = shFrom.Range(shFrom.Range("J2"), shFrom.Range("J2").End(xlDown))
    shTo.Range("J1").Resize(UBound(varTab), UBound(varTab, 2)) = varTab
 
    varTab = shFrom.Range(shFrom.Range("K2"), shFrom.Range("K2").End(xlDown))
    shTo.Range("K1").Resize(UBound(varTab), UBound(varTab, 2)) = varTab
 
    varTab = shFrom.Range(shFrom.Range("L2"), shFrom.Range("L2").End(xlDown))
    shTo.Range("L1").Resize(UBound(varTab), UBound(varTab, 2)) = varTab
 
    varTab = shFrom.Range(shFrom.Range("M2"), shFrom.Range("M2").End(xlDown))
    shTo.Range("M1").Resize(UBound(varTab), UBound(varTab, 2)) = varTab
 
    varTab = shFrom.Range(shFrom.Range("N2"), shFrom.Range("N2").End(xlDown))
    shTo.Range("N1").Resize(UBound(varTab), UBound(varTab, 2)) = varTab
 
   varTab = shFrom.Range(shFrom.Range("O2"), shFrom.Range("O2").End(xlDown))
    shTo.Range("O1").Resize(UBound(varTab), UBound(varTab, 2)) = varTab
 
   varTab = shFrom.Range(shFrom.Range("P2"), shFrom.Range("P2").End(xlDown))
    shTo.Range("P1").Resize(UBound(varTab), UBound(varTab, 2)) = varTab
 
    varTab = shFrom.Range(shFrom.Range("Q2"), shFrom.Range("Q2").End(xlDown))
    shTo.Range("Q1").Resize(UBound(varTab), UBound(varTab, 2)) = varTab
 
    varTab = shFrom.Range(shFrom.Range("R2"), shFrom.Range("R2").End(xlDown))
    shTo.Range("R1").Resize(UBound(varTab), UBound(varTab, 2)) = varTab
 
    varTab = shFrom.Range(shFrom.Range("S2"), shFrom.Range("S2").End(xlDown))
    shTo.Range("S1").Resize(UBound(varTab), UBound(varTab, 2)) = varTab
 
 
 
 
End Sub

Cependant, même s'il n'y a pas de message d'erreur qui apparaît lors de l'exécution du code ci-dessus, je ne parviens pas à ramener ces données issues du TCD. Quel code devrais-je utiliser selon vous ?

28/04/2016, 12h30
78chris
Bonjour

Ton code me semble inutilement compliqué : on peut copier une plage en une fois...

Pour copier un TCD
TCD lui-même

Code:

shFrom.PivotTables("Nom du TCD").TableRange2.Copy Destination:=shTo.Range("A1")

Son contenu seulement
Code:

1 2 shFrom.PivotTables("Nom du TCD").TableRange2.Copy shTo.Range("A1").PasteSpecial Paste:=xlPasteValues
28/04/2016, 13h19
fabien32200

Merci de ta réponse, 78chris :)
28/04/2016, 13h39
fabien32200
J'utilise ce code pour supprimer certaines colonnes. Cependant que faut-il que je rajoute pour supprimer les colonnes dont est présent sur la 2ème ligne de ma feuille le mot "PEA" ?

Exemple :

Colonne A..., B..., C.., D....,E..
Ligne 1 :
Ligne 2 : xxx..,xx..,PEA,xxx.,PEA

Ce code me permettrait de suprimer les colonnes C et E dans cet exemple.

J'ai pensé à utiliser l'enregistreur de macro, mais mes données peuvent changer d'un jour sur l'autre lorsque je vais les importer.
Code:

1 2 3 4 5 6 7 8 Sub Macro2() Range("O2").Select Selection.EntireColumn.Delete Range("S2").Select Selection.EntireColumn.Delete Range("J23").Select End Sub
28/04/2016, 14h22
78chris

Bonjour

Sur le TCD tu ne peux supprimer de ligne : il faut filtrer.

Sur une plage standard il faut faire une boucle ou un find. Mettre le calcul sur manuel au début et rétablir ensuite car les suppression provoquent souvent des recalculs.
28/04/2016, 15h39
fabien32200
Du coup j'ai utilisé ce code comme tu m'as dit :
Code:

1 2 Set shFrom = wkb.Worksheets("TCD Actifs") Set shTo = ThisWorkbook.Worksheets("Répartition")
Ainsi, tu m'as permis d'importer le contenu seulement du TCD.

Donc il m'est possible de supprimer des colonnes. Mais je souhaiterai avoir un code qui me permette de faire ceci :

"J'utilise ce code pour supprimer certaines colonnes. Cependant que faut-il que je rajoute pour supprimer les colonnes dont est présent sur la 2ème ligne de ma feuille le mot "PEA" ?

Exemple :

Colonne A..., B..., C.., D....,E..
Ligne 1 :
Ligne 2 : xxx..,xx..,PEA,xxx.,PEA

Ce code me permettrait de suprimer les colonnes C et E dans cet exemple.

J'ai pensé à utiliser l'enregistreur de macro, mais mes données peuvent changer d'un jour sur l'autre lorsque je vais les importer"
28/04/2016, 20h52
78chris
Re

Comme déjà dit
- soit tu filtres le TCD avant copie
- soit tu fais fais une boucle sur la plage de la ligne 2 sur les n colonnes (plus simple en partant de la fin)
  Code:
  
  1 2 3 4 Dercol = Cells(2, Columns.Count).End(xlToLeft).Column For i = Dercol To 1 Step -1 If InStr(Cells(2, i), "India") > 0 Then Columns(i).Delete Shift:=xlToLeft Next i
29/04/2016, 09h10
fabien32200

Merci une fois de plus 78Chris, pour ta réponse de qualité !
Problème résolu !

Et si je veux faire l'inverse : Supprimer les lignes dont est présent sur la colonne A le mot "PEA

Je n'ai plus qu'à remplacer "colums" par "range" ?
Code:

1 2 3 4 5 6 7 8 Sub Macro1() Dercol = Cells(2, Range.Count).End(xlToLeft).Range For i = Dercol To 1 Step -1 If InStr(Cells(2, i), "OPC") > 0 Then Range(i).Delete Shift:=xlToLeft Next i End Sub

Bonjour

Non un range est une plage pouvant avoir n lignes et n colonnes. C'est Row qui désigne la ligne
Code:

1 2 3 4 5 Derlig = Cells(Rows.Count, 1).End(xlUp).Row For i = Derlig To 2 Step -1 If InStr(Cells(i, 1), "OPC") > 0 Then Rows(i).Delete Shift:=xlUp Next i End Sub

29/04/2016, 11h50
fabien32200

Super merci 78chris