Copy to email

[bouncey]

Hi There,

I had code that worked for copying worksheet into an email but I now need to shorten that to everything in columns A to J until the cell is blank in A then copy and paste to email.

This is what I have managed so far, any and all help appreciated.

Private Sub Email_Click()


Dim r As Range


Application.ScreenUpdating = False


For Each r In .Range("A1", .Range("A1").End(xlDown))
.Range(.Cells(r.Row, "A"), .Cells(r.Row, "l")).Copy



With ActiveSheet.MailEnvelope
.Item.To = "Me"


End With
End Sub

 

[DanteAmor]

Try this:

Private Sub Email_Click()
    Application.ScreenUpdating = False
    ActiveWorkbook.EnvelopeVisible = True
    Range("A1:J" & Range("A" & Rows.Count).End(xlUp).Row).Select
    With ActiveSheet.MailEnvelope
        .Item.To = "Me"
        .Item.Send
    End With
    ActiveWorkbook.EnvelopeVisible = False
    Application.ScreenUpdating = True
    MsgBox "Sent range"
End Sub