how to send each row by email

[Admin]

Hi Baris,

Welcome to ExcelFox !!!

Try this

Sub SendEmailRowByRow()
    
    Dim OutApp      As Object
    Dim OutMail     As Object
    Dim strBody     As String
    Dim LastRow     As Long
    Dim eMailIDs, i As Long
    Dim varBody
    
    Const StartRow  As Long = 2     '<<< adjust to suit
    
    
    If Not Application.Intersect(Range("I:I"), ActiveSheet.UsedRange) Is Nothing Then
        
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
        
        LastRow = Range("I" & Rows.Count).End(xlUp).Row
        
        eMailIDs = Range("I" & StartRow).Resize(LastRow - StartRow + 1)
        
        For i = 1 To UBound(eMailIDs, 1)
            varBody = Range("a" & StartRow + i - 1).Resize(, 7).Value
            strBody = Join(Application.Transpose(Application.Transpose(varBody)), vbTab)
            On Error Resume Next
            With OutMail
                .To = eMailIDs(i, 1) 'email from corresponding row goes here
                .CC = ""
                .BCC = ""
                .Subject = "Subject"    '<< adjust subject line
                .Body = strBody
                'You can add a file like this
                '.Attachments.Add ("C:\")
                .Display
                'or use .Send
'                .Send
            End With
            On Error GoTo 0
        Next
    End If
    
    Set OutMail = Nothing
    Set OutApp = Nothing
    
End Sub