Bonjour,

J'ai un petit soucis, j'ai fait quelques macros pour déplacer des colonnes dans un tableau, cela fonctionne quand je n'ai qu'un tableau dans une feuille.

Mais dès que j'ai plusieurs tableaux cote à cote cela ne fonctionne plus, le résultat de RearrangeTable = 1004.

Avez-vous une idée ?

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
Sub Deplace_Colonne(Table As ListObject, ByVal Pos_Dep As Integer, ByVal Pos_Fin As Integer)
 
With Table
    If Pos_Dep <= .ListColumns.Count Then
        'If Pos_Fin > Table.ListColumns.Count Then Pos_Fin = Table.ListColumns.Count + 1
        .ListColumns(Pos_Dep).Range.Cut
        If Pos_Fin < Pos_Dep Then
            .ListColumns(Pos_Fin).Range.Insert shift:=xlToRight
        Else
            If Pos_Fin > .ListColumns.Count Then
                .ListColumns(.ListColumns.Count).Range.Offset(0, 1).Insert shift:=xlToRight
            Else
                .ListColumns(Pos_Fin - 1).Range.Insert shift:=xlToRight
            End If
        End If
    Else
        ' En dehors des limites
    End If
End With
End Sub
 
Sub Insert_Colonne(Table As ListObject, ByVal Nom As String, ByVal Position As Integer)
 
With Table
    If Position <= .ListColumns.Count Then
        .ListColumns(Position).Add
        .ListColumns(Position + 1).Name = Nom
    Else
        .ListColumns.Add
        .ListColumns(.ListColumns.Count).Name = Nom
    End If
End With
 
End Sub
 
Function ReArrange_Table(Table As ListObject, ByVal Colonnes, Optional KeepAllColumns As Boolean = False) As Long
 
Dim L_Colonne As ListColumn
Dim Compteur As Integer
Dim Position As Integer
 
On Error GoTo Fin
    For Compteur = LBound(Colonnes) To UBound(Colonnes)
        If Colonnes(Compteur) <> "" Then
            ' Ne traite que les colonnes ayant un nom
            If Existe_Colonne(Table, Colonnes(Compteur)) Then
                Call Deplace_Colonne(Table, Position_Colonne(Table, Colonnes(Compteur)), Table.ListColumns.Count + 1)
            Else
                Call Insert_Colonne(Table, Colonnes(Compteur), Table.ListColumns.Count + 1)
            End If
        End If
    Next Compteur
    If Not KeepAllColumns Then
        Do While Table.ListColumns.Count > UBound(Colonnes) + 1
            Table.ListColumns(1).Delete
        Loop
    Else
        For Compteur = 1 To Table.ListColumns.Count - (UBound(Colonnes) + 1)
            Table.ListColumns(1).Range.Cut
            Table.ListColumns(Table.ListColumns.Count).Range.Offset(0, 1).Insert shift:=xlToRight
        Next Compteur
    End If
Fin:
    Application.CutCopyMode = False
    If Err <> 0 Then ReArrange_Table = Err.Number
 
End Function