Bonsoir à tous,

Je vous sollicite pour une macro que j'utilise comme filtre auto.
Pour accélérer le filtre, je transpose sur une autre feuille les résultats du filtre.

Mon soucis est que la transposition ne prend pas en compte le format des cellules
Ci dessous le code utilisé.

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
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
If bActiver = False Then Exit Sub
 
    Dim n&, j&, ln%, i%, k%, conseil, etat$, tablo()
    If Target.Cells(1, 1) = "" Or Target.Count > 1 Then Exit Sub
    ' si case vide  pas de procédure
    Set sh = Sheets("Liste Demandes")
    sh.Range("B2").CurrentRegion.Offset(1).ClearContents
    ln = Me.Range("A" & Rows.Count).End(xlUp).Row
    If Not Intersect(Target, Me.Range("C5:h" & ln)) Is Nothing Then
        etat = Me.Cells(4, Target.Column)
        If Target.Row = ln Then
            For i = 5 To ln - 1
                conseil = conseil & ";" & Me.Cells(i, 1)
            Next i
        Else
            conseil = ";" & Me.Range("A" & Target.Row)
        End If
        conseil = Split(conseil, ";")
        With Worksheets("Stock Demandes")
            n = .Range("K" & .Rows.Count).End(xlUp).Row
            For j = 3 To n
                If .Cells(j, 6) = etat Then
                    For i = 1 To UBound(conseil)
                        If .Cells(j, 11) = conseil(i) Then Exit For
                    Next i
                    If i <= UBound(conseil) Then
                        k = k + 1: ReDim Preserve tablo(2 To 13, 1 To k)
                        For i = 2 To 13
                            tablo(i, k) = .Cells(j, i)
                        Next i
                    End If
                End If
            Next j
        End With
        With Worksheets("Liste Demandes")
            .Range("B2").Resize(k, 12).Value = WorksheetFunction.Transpose(tablo)
            .Visible = xlSheetVisible
            .Activate
        End With
    End If
End sub
Merci d'avance pour votre aide.
Sophie