Thread: Email Excel Function but data won't copy to other workbook?? Please help!!!

Hi so I've tested and the email function is working great, it emails with the attachment and it's copied in the body.

However the data is not copying to a consolidated workbook "destination.xls" what am I doing wrong, please help . I also would like it built so that each time its copied over it selects the next empty row.

Sub Picture23_Click()
    Dim Sendrng As Range
    Dim wSs As Worksheet, wDs As Worksheet
    Dim lr As Long
    
    On Error GoTo StopMacro

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'Note: if the selection is one cell it will send the whole worksheet
    Set Sendrng = Selection

                
    'Create the mail and send it
    With Sendrng

        ActiveWorkbook.EnvelopeVisible = True
        With .Parent.MailEnvelope

            ' Set the optional introduction field thats adds
            ' some header text to the email body.
            .Introduction = ""

            ' In the "With .Item" part you can add more options
            With .Item
                .To = "user@user.com"
                .Subject = "Subject Line"
                .Attachments.Add ActiveWorkbook.FullName
                .send
    
            'copying data to work list
            Set wSs = Workbooks("Origin.xls").Sheets("Sheet1")
            Set wDs = Workbooks("T:\destination.xls").Sheets("Sheet1")
            lr = wDs.Cells(Rows.Count, 6).End(xlUp).Row + 1
            wDs.Cells(lr, 1) = wSs.Cells(7, "C")
            wDs.Cells(lr, 2) = wSs.Cells(10, "C")
            wDs.Cells(lr, 3) = wSs.Cells(16, "C")
            wDs.Cells(lr, 4) = wSs.Cells(16, "G")
            wDs.Cells(lr, 5) = wSs.Cells(13, "C")
    
            End With
        End With
    End With

StopMacro:
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    ActiveWorkbook.EnvelopeVisible = False
End Sub

bump for Monday morning help please =)