Macro Excel For Copy Data To New Workbook And Auto Draft Email

Copy Data And Attachment to Email
Create New Excel Then Add Data like example below

Create new sheet for data to format email like below

Go to tab developer click visual basic

Create new module 

Copy and paste code in below

Sub CompileEmail()
 lastrow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
'MsgBox lastrow
 'lastcolumn = Sheet3.Cells(1, Columns.Count).End(xlToLeft).Column
 Workbooks.Add
 j = 3
 For i = 1 To lastrow
    Range("A" & i).Value = Sheet1.Range("A" & j)
    j = j + 1
 Next
 

'Step 4 Turn off application alerts
    Application.DisplayAlerts = False
'Step 5 Save the newly created workbook
     a = "C:\Users\Public\Documents\Makro_Create_New_And_Email_" & Replace(Replace(Replace(Now, "/", "_"), " ", "_"), ":", "_") & ".xlsx"
     ActiveWorkbook.SaveAs _
     Filename:=a
'Step 6 Turn application alerts back on
    Application.DisplayAlerts = True
    
Dim OutlookApp As Outlook.Application
Dim MItem As Outlook.MailItem
Dim cell As Range
Dim Subj As String
Dim EmailAddr As String
Dim Recipient As String
Dim msg As String

'Create Outlook object
Set OutlookApp = New Outlook.Application


'condition the rows
If Sheet2.Range("B3").Value Like "*@*" Then
EmailAddr = "" & Sheet2.Range("B3")
End If
If Sheet2.Range("B4").Value Like "*@*" Then
EmailCC = "" & Sheet2.Range("B4")
End If
'add subject to message
Subj = "" & Sheet2.Range("B5")

'Compose message
msg = "" & Sheet2.Shapes("TextBox 1").TextFrame.Characters.Text


'Create Mail Item and view before sending
Set MItem = OutlookApp.CreateItem(olMailItem)
With MItem
.To = EmailAddr
.CC = EmailCC
.Subject = Subj
.Body = msg
.Display 'change to .send if you want to send it before review

'Attach File
.attachments.Add a
End With

End Sub

On the sheet1 add new button and assign macro name Compile Email()
here is the result

Demo Video