XL 2019 VBA - Copier liste de mail dans presse papier

im_Guillaume · 24 Février 2022

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 · 24 Février 2022

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.

sylvanu · 24 Février 2022

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.

im_Guillaume · 24 Février 2022

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 · 24 Février 2022

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

im_Guillaume · 24 Février 2022

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

XL 2019 VBA - Copier liste de mail dans presse papier

im_Guillaume

XLDnaute Nouveau

Pièces jointes

sylvanu

sylvanu

XLDnaute Barbatruc

Pièces jointes

im_Guillaume

XLDnaute Nouveau

fanch55

XLDnaute Barbatruc

im_Guillaume

XLDnaute Nouveau

Discussions similaires