Discussion :

[Mokia34]

Bonjour,

je copie colle les données d'un TCD.
Il peut y avoir 3 étiquettes de lignes et il y a toujours le total général.

Je souhaite réarranger mon tableau selon son contenu.
En effet, le tableau doit être toujours de la forme suivante :
Individu Total général 0 1 inconnu

Mais selon le TCD, l'ordre des colonnes peut être différent après le copier-coller :
cas 1 : Étiquettes de lignes 0 inconnu Total général
cas 2 : Étiquettes de lignes 1 inconnu Total général
cas 3 : Étiquettes de lignes 0 1 Total général
cas 4 : Étiquettes de lignes 0 1 inconnu Total général

J'ai essayé d'écrire quelque chose mais cela ne marche pas.
Est ce que quelqu'un pourrait m'aider svp ??Classeur1.zip

Merci !!

[Invité]

Bonjour,

Une solution possible :

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
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
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
Sub ReorganiserLeTableau()
 
Dim ShTableau As Worksheet
Dim ShRecap As Worksheet
 
Dim LigneTitreRecap As Long
Dim DerniereColonneRecap As Long
Dim DerniereLigneRecap As Long
Dim J As Long
 
Dim OrdreTitre As Variant
 
Dim AireTitre As Range
Dim CelluleTitre As Range
Dim AireBordure As Range
 
Dim ColonneTrouvee As Boolean
Dim Continuer As Boolean
 
Dim Pvt As PivotTable
 
    Set ShTableau = Sheets("tableau")
    Set ShRecap = Sheets("Récap")
    ' Effacement de la feuille
    ShRecap.Cells.Clear
    LigneTitreRecap = 1
 
    ' Recherche du tableau dynamique dans la feuille tableau et copie dans la feuille Récap le cas échéant
    Continuer = False
    For Each Pvt In ShTableau.PivotTables
        If Pvt.Name = "Tableau croisé dynamique1" Then
           Continuer = True
           Set Pvt = ShTableau.PivotTables("Tableau croisé dynamique1")
           With ShTableau
                .Range(.Cells(Pvt.RowRange.Row, Pvt.RowRange.Column), .Cells(Pvt.TableRange1.Row + Pvt.TableRange1.Rows.Count - 1, Pvt.TableRange1.Column + Pvt.TableRange1.Columns.Count - 1)).Copy
                ShRecap.Activate
                ShRecap.Paste Destination:=ShRecap.Range("A1")
           End With
           Set Pvt = Nothing
        End If
 
    Next Pvt
 
    If Continuer = False Then Exit Sub
 
    ' On classe les valeurs cherchées dans l'ordre inverse final
    OrdreTitre = Array("inconnu", 1, 0, "Total général")
 
    With ShRecap
 
         ' Vérification de la présence des colonnes et création le cas échéant
         For J = 1 To 4
 
             DerniereColonneRecap = .Cells(LigneTitreRecap, .Columns.Count).End(xlToLeft).Column
             Set AireTitre = .Range(.Cells(LigneTitreRecap, 2), .Cells(LigneTitreRecap, DerniereColonneRecap))
 
             ColonneTrouvee = False
             For Each CelluleTitre In AireTitre
                 If CelluleTitre = OrdreTitre(J - 1) Then ColonneTrouvee = True
             Next CelluleTitre
 
              ' Si la colonne cherchée n'existe pas, on l'ajoute après la dernière colonne de la zone AireTitre
             If ColonneTrouvee = False Then .Cells(LigneTitreRecap, DerniereColonneRecap + 1) = OrdreTitre(J - 1)
 
             Set AireTitre = Nothing
 
          Next J
 
 
         ' Déplacement des colonnes
         For J = 1 To 4
 
             DerniereColonneRecap = .Cells(LigneTitreRecap, .Columns.Count).End(xlToLeft).Column
             Set AireTitre = .Range(.Cells(LigneTitreRecap, 2), .Cells(LigneTitreRecap, DerniereColonneRecap))
 
             ColonneTrouvee = False
             For Each CelluleTitre In AireTitre
                 If CelluleTitre = OrdreTitre(J - 1) Then
                        Columns(CelluleTitre.Column).Cut
                        If CelluleTitre.Column <> 2 Then
                            With Columns(2)
                                .Insert Shift:=xlToRight
                                .Cells.HorizontalAlignment = xlCenter
                                .ColumnWidth = 14
                            End With
                        End If
                        ColonneTrouvee = True
                 End If
             Next CelluleTitre
 
             Set AireTitre = Nothing
 
         Next J
 
         ' Mise en forme de la ligne de titre
         Set AireTitre = .Range(.Cells(LigneTitreRecap, 1), .Cells(LigneTitreRecap, DerniereColonneRecap))
         With AireTitre
             .Interior.Color = RGB(220, 230, 241)
             .Font.Bold = True
             .WrapText = True
             .EntireColumn.VerticalAlignment = xlCenter
             .Cells(1) = "Individu"
         End With
         Set AireTitre = Nothing
 
 
         ' Mise en forme de la dernière ligne "Total général"
         DerniereLigneRecap = .Cells(.Rows.Count, 1).End(xlUp).Row
         If .Cells(DerniereLigneRecap, 1) = "Total général" Then
            Set AireTitre = .Range(.Cells(DerniereLigneRecap, 1), .Cells(DerniereLigneRecap, DerniereColonneRecap))
            With AireTitre
                .Interior.Color = RGB(220, 230, 241)
                .Font.Bold = True
                .HorizontalAlignment = xlCenter
            End With
            Set AireTitre = Nothing
         End If
 
         ' Mise en place des bordures du tableau
         DerniereLigneRecap = .Cells(.Rows.Count, 1).End(xlUp).Row
         Set AireBordure = .Range(.Cells(LigneTitreRecap, 1), .Cells(DerniereLigneRecap, DerniereColonneRecap))
         With AireBordure
            .Borders(xlEdgeLeft).Weight = xlThin
            .Borders(xlEdgeTop).Weight = xlThin
            .Borders(xlEdgeBottom).Weight = xlThin
            .Borders(xlEdgeRight).Weight = xlThin
            .Borders(xlInsideVertical).Weight = xlThin
            If AireBordure.Rows.Count > 1 Then .Borders(xlInsideHorizontal).Weight = xlThin
        End With
        Set AireBordure = Nothing
 
  End With
 
 
  Set ShRecap = Nothing
  Set ShTableau = Nothing
 
End Sub

Cordialement.