Transposé d'une colonne avec filtre

Bonjour le réseau,

Je voulais ajouter dans la même macro que je possède dans le Fichier en PJ (bouton1), une fonction qui permet de filtrer sur la colonne Type en choisissant le critère C.

Le résultat doit être affiché dans la Feuille 2

La macro actuelle ne permet que transposer toute la colonne en ligne

Merci pour votre aide.

Bonjour,

à tester,

ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=3, Criteria1:="C"

ps/

pour enlever le critère

ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=3

Bonjour,

J'ai ajouté la formule dans la macro , elle filtre sur le tableau mais elle ne transpose pas que les valeurs filtrées.

Merci pour l'aide

i20100 a écrit :

Bonjour,

à tester,

ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=3, Criteria1:="C"

ps/

pour enlever le critère

ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=3

Bonjour,

J'ai ajouté la formule dans la macro , elle filtre sur le tableau mais elle ne transpose pas que les valeurs filtrées.

Y'a t-il une autre formule à ajouter ou bien je l'ai mal placé dans le code?

re,

à tester,

Sub concaténer_références()
    Dim c As Range, n As Integer
    Sheets("Sheet1").ListObjects("Table1").Range.AutoFilter Field:=3, Criteria1:="C"
    With Sheets("Sheet1").ListObjects(1).ListColumns("Référence")
        For Each c In .DataBodyRange.SpecialCells(xlCellTypeVisible)
          Sheets("Sheet2").Cells(10, 2 + n) = c.Value
          n = n + 1
        Next c
    End With
End Sub

ou bien,

Sub concaténer_références2()
    Dim c As Range, t As String
    Sheets("Sheet1").ListObjects("Table1").Range.AutoFilter Field:=3, Criteria1:="C"
    With Sheets("Sheet1").ListObjects(1).ListColumns("Référence")
        For Each c In .DataBodyRange.SpecialCells(xlCellTypeVisible)
          t = t & c.Value & ", "
        Next c
    End With
    Sheets("Sheet2").Range("B10") = t
End Sub

Bonjour ,

Merci beaucoup pour le retour

J'opte surtout pour la 2ème proposition, si non j'ai juste une remarque , c'est que la fonction de séparation par virgule s'affiche même pour le dernier chiffre. (voir photo)

Est-il possible de l'enlever pour n'importe quel chiffre affiché en dernier de la cellule?

re,

à tester,

Sub concaténer_références2()
    Dim c As Range, t As String
    Sheets("Sheet1").ListObjects("Table1").Range.AutoFilter Field:=3, Criteria1:="C"
    With Sheets("Sheet1").ListObjects(1).ListColumns("Référence")
        For Each c In .DataBodyRange.SpecialCells(xlCellTypeVisible)
          t = t & c.Value & ", "
        Next c
    End With
    Sheets("Sheet2").Range("B10") = Left(t, Len(t) - 2)
End Sub

Bonjour,

Parfait

Merci beaucoup

J'ai ajusté juste

Sheets("Sheet2").Range("B10") = Left(t, Len(t) - 2)

par

Sheets("Sheet2").Range("B10") = Left(t, Len(t) - 1)