vlookup match data and send an email

[mali10020]

Hello everyone! I hope you are doing well

I'm working on a project and I need help please!!

I have 2 sheets in my workbook Report and email.. The sheet "report" have all the data and sheet "email" have all the users email..

I would like the data shown in the report to go to the appropriate email associated with the cost centerI want this code to go to the

Email sheet

Test1@gmail.com	10259​
Test2@gmail.com	10280​
Test3@gmail.com	10286​
Test4@gmail.com	10289​
Test5@gmail.com	10291​
Test6@gmail.com	10298​
Test7@gmail.com	10298​

Report sheet

Device name	MAC	Location	Model	cost center
CGS0059565	3C:CD:88:E1:59:75	5T	iPHone 13	10259​
CGS008453	3C:CD:88:E1:59:OP	5Y	iPHone 13	10280​
CGI0056465	3C:CD:88:E1:59:75	6G	iPHone 13	10280​
CGS0036548	3C:CD:88:E1:59:00	5B	iPHone 13	10280​
CGS0046465	3C:CD:88:E1:59:32:46	5N	iPHone 13	10286​
CGS00789532	3C:CD:88:E1:59:09	1R	iPHone 13	10286​
CGS76615	3C:CD:88:E1:59:85	9U	iPHone 13	10289​
CGS00324569	3C:C45:D:88:E1:59	6W	iPHone 13	10291​
CGS006463	3C:CD:88:E1:59:HY	5T	iPHone 13	10298​
CGI7564	3C:CD:88:E1:59:VT	1A	iPHone 13	10298​
IPH007652	3C:CD:88:E1:59:12	7O	iPHone 13	10298​
IPH1254233	3C:CD:88:E1:59:76	9W	iPHone 13	10298​
IPH00986	3C:CD:88:E1:59:DT	6L	iPHone 13	10298​

Sub Email_Report()
    Dim Source As Range
    Dim Dest As Workbook
    Dim wb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim OutApp As Object
    Dim OutMail As Object

    Set Source = Nothing
    On Error Resume Next
    Set Source = Worksheets("Report").Range("A:I").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    If Source Is Nothing Then
        MsgBox "The source is not a range or the sheet is protected, please correct and try again.", vbOKOnly
        Exit Sub
    End If

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

    Set wb = ActiveWorkbook
    Set Dest = Workbooks.Add(xlWBATWorksheet)

    Source.Copy
    With Dest.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial Paste:=xlPasteValues
        .Cells(1).PasteSpecial Paste:=xlPasteFormats
        .Cells(1).Select
        Application.CutCopyMode = False
    End With

    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Selection of " & wb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

    If Val(Application.Version) < 12 Then
        'You use Excel 97-2003
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
        'You use Excel 2007-2016
        FileExtStr = ".xlsx": FileFormatNum = 51
    End If

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    With Dest
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        On Error Resume Next
        With OutMail
            .To = ""
            .CC = ""
            .BCC = ""
            .Subject = "TEST Daily Mobile Devices Report"
            .Body = "Good evening! "
            .Attachments.Add Dest.FullName
            'You can add other files also like this
            '.Attachments.Add ("C:\Report.txt")
            .Send   'or use .Display
        End With
        On Error GoTo 0
        .Close SaveChanges:=False
    End With

    Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

 

[mali10020]

Can someone please help! Thanks !!

 

[mali10020]

Is what I'm trying to do is possible.. Please assist if you can.

Thank you!