这是一个代码片段，它将完成您想要的任务：

Sub test_func()

    ' this is the starting cell (keep in mind that the first word in the cell is 'Jack' so the start cell is actually starting at C2)
    Dim startCell As range
    Set startCell = ThisWorkbook.ActiveSheet.range("B2")
    
    ' reading all the cells in the range
    Dim wordRange As range
    Set wordRange = ThisWorkbook.ActiveSheet.range("A2:A13")
    
    ' creating two variables row and col
    Dim row As Long
    Dim col As Long
    
    ' for each word in wordRange
    Dim word As Variant
    For Each word In wordRange
        ' as soon as we find the word 'Jack'
        If word.Value = "Jack" Then
            ' move the cursor to row 0
            row = 0
            ' move the cursor one cell to the right
            col = col + 1
        End If
        ' else if the word is not 'Jack', put the word on the cursor cell
        startCell.Offset(row, col) = word
        ' then move the cursor one cell down
        row = row + 1
    Next

End Sub

函数为：
1.将列A中的所有单词读入一个范围。
1.从B2开始逐个转储范围（字）中的元素
1.一旦找到单词“Jack”，它将从第0行开始，向右移动并继续
结果如下所示：This is the output of the script
请注意，即使您选择B2作为起始单元格，单词也是从C2开始的;这是因为列表中的第一个单词是“Jack”，所以它一开始就向右移动一个单元格。
编辑：这里可能是你正在寻找的函数：

Sub test_func()

    ' this is the starting cell (keep in mind that the first word in the cell is 'Jack' so the start cell is actually starting at C2)
    Dim startCell As range
    Set startCell = ThisWorkbook.ActiveSheet.range("B2")
    
    ' reading all the cells in the range
    Dim wordRange As range
    Set wordRange = ThisWorkbook.ActiveSheet.range("A2:A13")
    
    ' creating two variables row and col
    Dim row As Long
    Dim col As Long
    
    ' string that holds each sentence
    Dim sentence As String
    
    ' for each word in wordRange
    Dim word As Variant
    For Each word In wordRange
        ' as soon as we find the word 'Jack' and the sentence is not empty, the sentence is complete
        If word.Value = "Jack" And sentence <> "" Then
            'printing out the whole sentence
            startCell.Offset(row, col) = sentence
            ' emptying the sentence when 'Jack' is found
            sentence = ""
            ' move the cursor one cell down
            row = row + 1
        End If
        ' else if the word is not 'Jack', concatenates the word into the sentence
        sentence = sentence & " " & word
    Next
    
    ' adding this again at the end of the loop because the last sentence is not outputted otherwise
    startCell.Offset(row, col) = sentence

End Sub

这个函数与上一个函数的不同之处在于，它是将单词连接成一个句子，然后再将句子转储出来。在这个函数中，开始单元格是正确的，在程序启动时不会向下或向右移动。这是因为我们可以检查它要转储出来的句子是否为空，如果为空;那就说明我们的话还没说完
希望这对你有帮助！This is the result screenshot of the second version of the code

从列中提取句子

Sub JACK()

    Const JackStart As String = "Jack"
    Const JackEnd As String = "."
    Const Delimiter As String = " "

    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    
    Dim slCell As Range: Set slCell = ws.Cells(ws.Rows.Count, "A").End(xlUp)
    Dim srg As Range: Set srg = ws.Range("A2", slCell)
    
    Dim dCell As Range: Set dCell = ws.Range("B2")
        
    Dim sCell As Range
    Dim JackString As String
    Dim FoundFirst As Boolean
    
    For Each sCell In srg.Cells
        If sCell.Value = JackStart Then
            If FoundFirst Then
                dCell.Value = JackString & JackEnd
                Set dCell = dCell.Offset(1) ' next row
            Else
                FoundFirst = True
            End If
            JackString = JackStart
        Else
            If FoundFirst Then JackString = JackString & Delimiter & sCell.Value
        End If
    Next sCell
    
    dCell.Value = JackString & JackEnd
    
    MsgBox "Jacks extracted.", vbInformation
    
End Sub