send e-mail from excel under conditions (automatically)

[whitoulias]

Sub email()
Dim myOutlook As Object
Dim myMailItem As Object
Dim FName As String
Set otlApp = CreateObject("Outlook.Application")
Set otlNewMail = otlApp.CreateItem(olMailItem)
FName = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
With otlNewMail
.To = "xxx@www.com;xxx1@www.com"
.CC = ""
.Subject = "new itens "
.Body = "Attached you may find new items expiring in 7 days"
.Attachments.Add FName
.DeferredDeliveryTime = Range("I2")
.Send
End With
 
Set otlNewMail = Nothing
Set otlApp = Nothing
Set otlAttach = Nothing
Set otlMess = Nothing
Set otlNSpace = Nothing
End Sub

Good day to all

This code runs fine in order to send an e-mail from outlook while i'm in excel.
I would like to change it a bit

The excel has 4 sheets.

The third sheet is named "new items".

In this sheet in COLUMN K i have numbers and empty cells.

What i would like is when in COLUMN K number "7" exists then copy the enire row- and all other rows with "7" to a new excel named "new items" and send an e-mail to specific receipients with "new items" attached.

I will change the code above in order to run this macro by workbook.open()

Plus i'm thinking of adding a message box if no "7"'s exist

Any thoughts?
Thank you

 

[whitoulias]

Sub Transfer()
    Dim c As Long
    Dim wsD As Worksheet: Set wsD = Worksheets("new items")    'Data Worksheet.
    Dim wsR As Worksheet: Set wsR = Worksheets("xxx")    'Results Worksheet
    
    For c = 2 To 3002    'Loop through 3000 records.
        With wsD.Range("K" & c)
            If .Value = 7 Then    'Test for 7.
                wsD.Range("B" & c & ":S" & c & "").Copy
                wsR.Activate
                wsR.Range("A" & wsR.Range("A" & Rows.Count).End(xlUp).Row + 1).Select
                Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
                                                                              :=False, Transpose:=False
                
                        End If
              End With
    Next c

In addition i have also the code for copy paste rows with 7 but to a new sheet in the same excel

Can i somehow combine both?

 

[VoG]

Duplicate of http://www.mrexcel.com/forum/showth...l-from-excel-under-conditions-(automatically)

Please do not post the same question multiple times. All clarifications, follow-ups, and bumps should be posted back to the original thread. Per forum rules, posts of a duplicate nature will be locked or deleted (rule #9 here: http://www.mrexcel.com/forum/showthread.php?t=99490).