下面的示例***可能不起作用***因为您没有在工作表上发布数据的副本，所以我必须做一些假设。请将此示例用作如何组织代码的示例。
你的主要问题是你的代码的组织，包括循环内部和外部。在我的例子中，我通过将大块的代码拉到其他例程中来简化主要逻辑。这应该会使你的代码的整体“流程”更容易阅读和使用。
请注意以下几点：
1.对区域、工作表和工作簿始终使用fully qualify your references。
1.避免magic numbers
将下面的代码修改为您自己的数据，看看是否有帮助。

Option Explicit

Sub Example()
    Dim statusWS As Worksheet
    Set statusWS = ThisWorkbook.Sheets("Check Reconciliation Status")
    PrepareData statusWS
    
    Const NAME_COL As Long = 1
    Const DATE_COL As Long = 12
    Const CHKNUM_COL As Long = 11
    Const AMT_COL As Long = 8
    Const TOADDR_COL As Long = 14
    
    '--- only do this once
    Dim outlookApp As Outlook.Application
    Set outlookApp = AttachToOutlookApplication
    
    With statusWS
        Dim lastRow As Long
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        
        Dim i As Long
        For i = 2 To lastRow
            If .Cells(i, TOADDR_COL).Value <> vbNullString Then
                '--- create the email now that everything is ready
                Dim email As Outlook.MailItem
                Set email = outlookApp.AddItem(0)
                With email
                    .To = statusWS.Cells(i, TOADDR_COL)
                    .Subject = "Open Vouchers"
                    .HTMLBody = BuildEmailBody(statusWS.Cells(i, NAME_COL), _
                                          statusWS.Cells(i, DATE_COL), _
                                          statusWS.Cells(i, CHKNUM_COL), _
                                          statusWS.Cells(i, AMT_COL))
                    '--- send it now
                    '    (if you want to send it later, you have to
                    '     keep track of all the emails you create)
                    .Send
                End With
            End If
        Next i
    End With
    
End Sub

Sub PrepareData(ByRef ws As Worksheet)
    With ws
        .Rows("1:6").Delete
        .Range("A1:N1").AutoFilter
        .AutoFilter.Sort.SortFields.Clear
        .AutoFilter.Sort.SortFields.Add2 Key:=Range("A1"), SortOn:=xlSortOnValues, Order:= _
            xlAscending, DataOption:=xlSortTextAsNumbers
        With .AutoFilter.Sort
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        '.Rows("2:5").Delete Shift:=xlUp
        .Range("i2") = "Yes"
        
        '--- it only makes sense to find the last row after all the
        '    other prep and deletions are complete
        Dim lastRow As Long
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range("I2").AutoFill Destination:=Range("I2:I" & lastRow)
    End With
End Sub

Function BuildEmailBody(ByVal name As String, _
                        ByVal checkDate As Date, _
                        ByVal checkNumber As Long, _
                        ByVal checkAmt As Double) As String

    Const body1 As String = "<Font face = TimesNewRoman p style=font-size:18.5px color = " & _
                            "#0033CC)"
    Const body2 As String = "<Font face = TimesNewRoman p style=font-size:18.5px color = " & _
                            "#0033CC)<br><br>You are receiving this email because our " & _
                            "records show you have vouchers open as follows:  "
    Const body3 As String = "<B><br><br>Please reply to this email with any questions." & _
                            "<br><br>***If we do not receive a reply from you within " & _
                            "the next 30 days, you will not be paid.<br><br>"
    Dim body As String
    body = body1 & TimeOfDayGreeting & name & "," & body2
    body = body & "<br><br>Voucher #:  " & checkNumber
    body = body & "<br>Check Date:  " & Format(checkDate, "dd-mmm-yyyy")
    body = body & "<br>Check Amount:  " & Format(checkAmt, "$#,##0.00")
    body = body & body3 & EmailSignature
    BuildEmailBody = body
End Function

Function EmailSignature() As String
    Dim sigCheck As String
    sigCheck = Environ("appdata") & "\Microsoft\Signatures\Uncashed Checks.htm"
    
    If Dir(sigCheck) <> vbNullString Then
        EmailSignature = GetBoiler(sigString)
    Else
        EmailSignature = vbNullString
    End If
End Function

Function TimeOfDayGreeting() As String
    Select Case Time
      Case 0.25 To 0.5
           TimeOfDayGreeting = "Good morning "
      Case 0.5 To 0.71
           TimeOfDayGreeting = "Good afternoon "
      Case Else
           TimeOfDayGreeting = "Good evening "
   End Select
End Function

Public Function OutlookIsRunning() As Boolean
    '--- quick check to see if an instance of Outlook is running
    Dim msApp As Object
    On Error Resume Next
    Set msApp = GetObject(, "Outlook.Application")
    If Err > 0 Then
        '--- not running
        OutlookIsRunning = False
    Else
        '--- running
        OutlookIsRunning = True
    End If
End Function

Public Function AttachToOutlookApplication() As Outlook.Application
    '--- finds an existing and running instance of Outlook, or starts
    '    the application if one is not already running
    Dim msApp As Outlook.Application
    On Error Resume Next
    Set msApp = GetObject(, "Outlook.Application")
    If Err > 0 Then
        '--- we have to start one
        '    an exception will be raised if the application is not installed
        Set msApp = CreateObject("Outlook.Application")
    End If
    Set AttachToOutlookApplication = msApp
End Function