代码工作正常！除了一个问题，我有一个部分ccomment '这一行忽略了序列。
例如，这一行应该在第二个循环中对从809到1608的行应用连接;而是从9号到1608号。
第三个循环-从9到2408，而不是1609到2408。
以此类推。它正确地计算出了endref。但是启动有一个问题。我做错了什么？如何修复这个问题，使每个x按计划连接以下800行？谢谢！如果你想尝试代码，这里是：enter link description here

Sub Mailer()

    Sheets("Data").Select
    Range("A5").Value = 0
    Range("A6").Value = 5
    Range("A7").Value = 9
    Range("A8").Value = 808
    Range("G2").Value = ""
       
    loopref = Sheets("Data").Range("A4").Value
    
    For x = 1 To loopref
    
If Sheets("Data").Range("A5").Value < Sheets("Data").Range("A4").Value Then
       
    'autos
    howlong = Sheets("Data").Range("A6").Value
    startref = Sheets("Data").Range("A7").Value
    endref = Sheets("Data").Range("A8").Value
       
    
    Dim rng As Range
    Dim i As String
    Dim SourceRange As Range

    
''''''''''''''''''''''''''''''THIS LINE is ignoring the sequence
    Set SourceRange = ThisWorkbook.Sheets(1).Range("B" & startref & ":B" & endref)

    
    For Each rng In SourceRange
    i = i & rng & "; "
    Next rng
    Sheets("Data").Range("G2").Value = Trim(i)

    Sheets("Welcome").Select
    Dim wd As Object, editor As Object
    Dim doc As Object
    Dim oMail As MailItem
    
    ActiveSheet.Shapes.Range(Array("Object 1")).Select
    Selection.Verb Verb:=xlPrimary
    Set wd = GetObject(, "Word.Application")
    Set doc = ActiveDocument
    doc.Content.Copy
    doc.Close
    Set wd = Nothing

     Set OutApp = CreateObject("Outlook.Application")
     Set oMail = OutApp.CreateItem(olMailItem)
     With oMail
        .Display
        .BCC = Sheets("Data").Range("G2").Value
        .Subject = "Type your subject here"
        .BodyFormat = olFormatRichText
        Set editor = .GetInspector.WordEditor
        editor.Content.Paste
        .DeferredDeliveryTime = DateAdd("n", howlong, VBA.Now)
        .Send
    End With
    
    'adjust autos
    Sheets("Data").Range("A5").Value = Sheets("Data").Range("A5").Value + 1
    Sheets("Data").Range("A6").Value = Sheets("Data").Range("A6").Value + 60
    Sheets("Data").Range("A7").Value = Sheets("Data").Range("A7").Value + 800
    Sheets("Data").Range("A8").Value = Sheets("Data").Range("A8").Value + 800
    Sheets("Data").Range("G2").ClearContents
    
    
    'reset if exceeds
    If Sheets("Data").Range("A7").Value > 99209 Then
    Sheets("Data").Range("A7").Value = 9
    End If
    
    If Sheets("Data").Range("A8").Value > 100008 Then
    Sheets("Data").Range("A7").Value = 808
    End If

End If
    Next x

MsgBox "Sent to Outbox!"
Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox "Sent to outbox!"

End Sub