XL 2019 VBA - Copier liste de mail dans presse papier

[im_Guillaume]

Bonjour le forum,

Voici mon problème :
J'ai un tableau évolutif (des lignes vont être masquées par moment selon les volontés des utilisateurs) et je dois développer un code VBA qui permet de copier dans le presse papier la liste des email à l'écran.

L'idéal serait de les copier avec un séparateur ";" de façon à ce que l'utilisateur n'ai plus qu'à copier coller dans son envoi de mail.

Voilà mon code actuel qui ne fonctionne pas :

'Sub Selectmail()
'listemail = ""
'For Each c In Sheets("Feuil1").Range("J10").CurrentRegion.Cells(1)
' listemail = listemail & Sheets("Base de données").Cells(10, c).Value & ";"
' Next c
'
' Cells(10, Columns.Count) = listemail
' Cells(10, Columns.Count).Copy
'End Sub
'

Ci-joint le fichier.

Merci pour votre aide!

 

[sylvanu]

Bonjour Guillaume,
Un essai en PJ avec :

Sub Liste()
    Dim L%, listemail$
    listemail = ""
    For L = 11 To Range("J65500").End(xlUp).Row
        If Rows(L).Hidden = False Then
            listemail = listemail & Cells(L, "J") & ";"
        End If
    Next L
    Cells(9, "J") = Left(listemail, Len(listemail) - 1): Cells(9, "J").Copy
End Sub

NB: utilisez les balises </> pour le code, c'est beaucoup plus lisible.

 

[im_Guillaume]

Merci pour votre réponse et votre temps Sylvanu!
Je vais l'implanter dans mon document source

Oui effectivement, j'y penserai la prochaine fois

 

[fanch55]

Bonjour à tous,
Une autre méthode sans cellule "tampon" :

Sub ListMail()
Dim First_Cell As Range, Last_Cell As Range, Cur_Cell As Range
    With Worksheets("Feuil1")
        Set First_Cell = .Cells.Find("Mail").Offset(1)
        If Not First_Cell Is Nothing Then
            Set Last_Cell = .Cells(.Rows.Count, First_Cell.Column).End(xlUp)
            For Each Cur_Cell In .Range(First_Cell, Last_Cell).SpecialCells(xlCellTypeVisible)
                List = List & Cur_Cell.Value & ";"
            Next
            With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
                .SetText Trim(List): .PutInClipboard
            End With
            .Paste [J8] ' <-- pour vérif
        End If
    End With
    Application.CutCopyMode = False
End Sub

 

[im_Guillaume]

Merci pour votre message Fanch!
C'est top et c'est vrai que ça évite une case intermédiaire.
Merci pour votre aide et votre temps