Option Explicit
'
Sub CopieDepuisA2()
Dim F As Worksheet, Te(), Ts() As String, Le As Long, Ls As Long
Set F = ActiveSheet
Te = F.Range(F.[A2], F.Cells(F.Rows.Count, "A").End(xlUp)).Value
For Le = 1 To UBound(Te)
If Not IsEmpty(Te(Le, 1)) Then ReDim Preserve Ts(0 To Ls): Ts(Ls) = Te(Le, 1): Ls = Ls + 1
Next Le
PressePapier = Join(Ts, vbCrLf)
End Sub
'
Rem. Important: Cochez "Microsoft Forms 2.0 Object Library" dans la liste Références disponibles, menu Outils, Références…
Property Get PressePapier() As String
Dim DOb As New DataObject
On Error Resume Next
DOb.GetFromClipboard: PressePapier = DOb.GetText
If Err Then MsgBox "Pas de données récupérées", vbCritical, "PressePapier"
End Property
Property Let PressePapier(Z As String)
Dim DOb As New DataObject
DOb.SetText Z: DOb.PutInClipboard
End Property