transposer liste de noms

[maval]

Bonjour

J'ai dans une colonne A5 une liste de noms. A l'aide de mon bouton j'aimerai qu'il m'affiche en colonne "D" ceci

                 <text font-size="100" x="-110" y="50" display="none" style="font-size:15px;font-weight:bold;fill: #bbef0d;font-family:Verdana">
xxxxxx
       <animate fill="freeze" dur="0.1s" begin="01.mouseover" from="none" to="block" attributeName="display"></animate>
       <animate fill="freeze" dur="0.1s" begin="01.mouseout" from="block" to="none" attributeName="display"></animate>
           </text>

Je join mon fichier qu'il seras plus explicite.

Max

 

[Theze]

Bonjour,

Un truc dans le genre ?

Sub Test()
   
    Dim Plage As Range
    Dim Cel As Range
    Dim Lig As Long
    Dim TxtDebut As String
    Dim TxtFin As String
    Dim TxtAnimal1 As String
    Dim TxtAnimal2 As String
    Dim I As Long
   
    With Worksheets("Feuil1")
   
        Set Plage = .Range(.Cells(5, 1), .Cells(.Rows.Count, 1).End(xlUp))
   
        Lig = 5
       
        For Each Cel In Plage
       
            I = I + 1
            TxtDebut = "                 <text font-size=""100"" x=""-110"" y=""50"" display=""none"" style=""font-size:15px;font-weight:bold;fill: #bbef0d;font-family:Verdana"">"
            TxtAnimal1 = "       <animate fill=""freeze"" dur=""0.1s"" begin=" & Format(I, "00") & ".mouseover"" from=""none"" to=""block"" attributeName=""display""></animate>"
            TxtAnimal2 = "       <animate fill=""freeze"" dur=""0.1s"" begin=" & Format(I, "00") & ".mouseout"" from=""block"" to=""none"" attributeName=""display""></animate>"
            TxtFin = "           </text>"
           
            .Cells(Lig, 4).Value = TxtDebut
            .Cells(Lig + 1, 4).Value = Cel.Value
            .Cells(Lig + 2, 4).Value = TxtAnimal1
            .Cells(Lig + 3, 4).Value = TxtAnimal2
            .Cells(Lig + 4, 4).Value = TxtFin
           
           Lig = .Cells(.Rows.Count, 4).End(xlUp).Row + 1
           
        Next Cel
   
    End With
   
End Sub

 

[maval]

Salut Theze

C'est exactement cela et je te remercie beaucoup. Juste une petite modif, comment faire pour que, si les cellules sont déjà remplis effacer les cellules en "D".
Ou je fait une macro pour effacer avant?

Merci beaucoup
Max

 

[herve62]

Bonjour le forum
Maval vu que tu n'as pas eu de réponse je me permets de terminer
Effacement : est ce pour re écrire dessus comme j'ai fait ou effacer la plage précédente pour re écrire
en dessous ? Là Theze écrit à la suite donc si tu lances 10 fois tu es vite à la ligne 1000 !!
Comme dit : j'efface et je re écris dessus

 

[Theze]

Bonjour,

juste sous "With Worksheets("Feuil1")" tu mets cette ligne de code :

.Columns(4).Cells.Clear

 

[maval]

Salut Herve, Theze,

Oui j'ai mis cette ligne comme tu le suggérer sa fonctionne Nickel.

Je te remercie
Max