XL 2019 VBA - Copier liste de mail dans presse papier

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

im_Guillaume

XLDnaute Nouveau
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! 🙂
 

Pièces jointes

Solution
Bonjour Guillaume,
Un essai en PJ avec :
VB:
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.
Bonjour Guillaume,
Un essai en PJ avec :
VB:
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.
 

Pièces jointes

Bonjour à tous,
Une autre méthode sans cellule "tampon" :
VB:
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
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
6
Affichages
668
Réponses
5
Affichages
763
Retour