Transposer sur une seule cellule

[Hulk]

Hello Forum

J'ai en colonne A2:Ax une liste comme ceci :

Pomme
Poire
Pêche
Nectarine
Banane
Ananas

Je souhaiterais la transposer sur une seule cellule (par ex. D1) comme ceci :

Pomme-Poire-Pêche-Nectarine-Banane-Ananas-

Pour l'instant je fais ceci..

Private Sub CommandButton1_Click()

    Dim lign As Range
    
    For Each lign In Range([A2], [A65000].End(xlUp))
    
        If Range("A" & lign.Row).Value <> "" Then
        
            Range("D1").Value = Range("A" & lign.Row).Value & "-"
        
        End If
    
    Next lign

End Sub

Mais il n'affiche que la dernière valeur de la liste -> Ananas-

Quelqu'un pour un p'tit coup de main ?

Merci d'avance pour vos propositions !

Bonne fin de journée à tous

 

[mth]

Re : Transposer sur une seule cellule

Hello Hulk

Peut-être en modifiant juste cette ligne ? :

Range("D1").Value = Range("D1") & "-" & Range("A" & lign.Row).Value

@ +

mth

 

[Si...]

Re : Transposer sur une seule cellule

salut

Si... tu veux simplifier, tu peux faire

Private Sub CommandButton1_Click()
  Dim C As Range
  [D1] = ""
  For Each C In Range([A2], [A65000].End(xlUp)).SpecialCells(xlCellTypeConstants)
    [D1] = [D1] & C & "-"
  Next
  '[D1] = Left([D1], Len([D1]) - 1) 'pour enlever le dernier tiret
End Sub

 

[BOISGONTIER]

Re : Transposer sur une seule cellule

Bonjour,

Set champ = Range([A2], [A65000].End(xlUp))
[d1] = Join(Application.Transpose(champ), "-")

Sous forme de fonction:

Function transpo(champ As Range)
transpo = Join(Application.Transpose(champ), "-")
End Function

=Transpo(A1:A5)


jb

 

[Hulk]

Re : Transposer sur une seule cellule

Mth, Si, Boisgontier, Forum,

Désolé de ne pas avoir répondu avant.

Merci pour vos réponses, elles sont toutes nickel.

Très bonne journée à vous !