Vba 搜索两个值并在循环中复制中间的所有内容

我有一个工作表，在a列中有许多术语。例如，我想搜索两个术语 术语A和术语B，复制两个术语之间的所有行，并将其粘贴到新的工作表中。这两个术语可能会在列中重复。我基本上面临以下问题：每当我运行代码时，它也会复制术语B和术语A之间的行，这是不必要的。下面是我对术语A和术语B使用的代码。 例如，我的A列是

学会 事件 工作 电脑类 笔记本电脑 数字 事件 数字 格式 计算机

还有更多的术语 我想复制术语A:事件和术语B:笔记本电脑之间的所有行，并将其粘贴到新的工作表中。我的代码所做的是在事件和计算机的所有组合之间复制行。甚至计算机和事件之间的行也会被复制（在本例中，是指图形和笔记本电脑）

编辑：代码格式。

尝试以下操作：

Sub DoEeeeeet(sheetName, termA, termB)

    Dim foundA As Range, _
        foundB As Range
    Dim newSht As Worksheet

    With Sheets(sheetName).Columns(1)
        Set foundA = .Find(termA)
        If Not foundA Is Nothing Then
            Set foundB = .Find(termB, after:=foundA, searchdirection:=xlPrevious)
        End If
    End With

    If foundA Is Nothing Or foundB Is Nothing Then
        MsgBox "Couldn't find " & IIf(foundA Is Nothing, termA, termB)
    Else
        Range(foundA, foundB).Copy
        Set newSht = Sheets.Add
        newSht.Range("B13").PasteSpecial
    End If

End Sub

你可以这样称呼它：

DoEeeeeet "Sheet1","Event","Laptop"

它将在名为“Sheet1”的工作表上找到“Event”的第一个实例和“Laptop”的最后一个实例，并将所有数据复制到新工作表中的B13和后续单元格中

---

这就是你想要的吗？或者是否希望每个子范围都以“事件”开头，以“笔记本电脑”结尾？

以下是适用于我的代码。这将复制事件和笔记本电脑之间的所有内容，并将其粘贴到新的工作表中。然后它再次搜索第二次，这次搜索将从下一行开始到第一次搜索。我希望我清楚这一点

  Sub Star123()
   Dim rownum As Long
   Dim colnum As Long
   Dim startrow As Long
   Dim endrow As Long
   Dim lastrow As Long
   rownum = 1
   colnum = 1
   lastrow = Worksheets("Startsheet").Range("A65536").End(xlUp).Row
   With ActiveWorkbook.Worksheets("StartSheet").Range("a1:a" & lastrow)


   For rownum = 1 To lastrow
    Do
       If .Cells(rownum, 1).Value = "Event" Then
          startrow = rownum
       End If

       rownum = rownum + 1


   If (rownum > lastrow) Then Exit For

   Loop Until .Cells(rownum, 1).Value = "Laptop"
   endrow = rownum
   rownum = rownum + 1

   Worksheets("StartSheet").Range(startrow & ":" & endrow).Copy


   Sheets("Result").Select
   Range("A1").Select
   ActiveSheet.Paste


   Next rownum
   End With
   End Sub

---

请充分格式化您的代码。此外，请提供您的数据示例以及您希望获得的结果。例如：术语A:1。学期乙：2。数据示例：[1；2；3；1；0；2]。期望的结果：[1；2]，[1；0；2]。@mkingston对于由此带来的不便，我深表歉意。我对编码和堆栈溢出非常陌生，不清楚其格式。我已经编辑了我的问题，并试图尽可能清楚。请知道是否还有其他事情要做。我已经编辑了您的格式化代码，以便您可以看到应该如何做。它正在等待审查，所以一旦审查完成，你就会看到它。@mkingston我确实试过了。问题：我的专栏是Institute Event Job Computer Laptop Figures Event Figures format Computer Laptop我想复制“Event Job Computer Laptop”和“Event Figures format Computer Laptop”，而不是“Event Job Computer Laptop Fires Event Fires format Computer Laptop”，可能吗？谢谢你的帮助。我也想要子范围。我想复制事件和作业之间所有可能的行。您尝试过我的代码吗？你的评论向我表明你没有。它复制第一个实例“事件”和最后一个实例“笔记本电脑”之间的所有单元格（包括）。请说明您是否尝试过该代码，以及它做了什么或没有做什么是不合适的。我确实尝试过。问题：我的专栏是研究所事件工作计算机笔记本电脑数字事件数字格式计算机笔记本电脑我想复制“事件工作计算机笔记本电脑”和事件数字格式计算机笔记本电脑，而不是“事件工作计算机笔记本电脑数字事件数字格式计算机笔记本电脑”有可能吗？@ankitagrawal，抱歉，过了一会儿才回复你，我已经离开一个长周末了。查看修订后的代码，它将找到termA的第一个实例，然后是termB的下一个实例。如果有帮助，请告诉我。没有问题，谢谢你的回复。正如我之前所说，在第列中有许多术语A和术语B。我想要在所有术语A和所有术语B之间的行。无论如何，我终于可以为它编写代码了。我上传到这里。请看

  Sub Star123()
   Dim rownum As Long
   Dim colnum As Long
   Dim startrow As Long
   Dim endrow As Long
   Dim lastrow As Long
   rownum = 1
   colnum = 1
   lastrow = Worksheets("Startsheet").Range("A65536").End(xlUp).Row
   With ActiveWorkbook.Worksheets("StartSheet").Range("a1:a" & lastrow)


   For rownum = 1 To lastrow
    Do
       If .Cells(rownum, 1).Value = "Event" Then
          startrow = rownum
       End If

       rownum = rownum + 1


   If (rownum > lastrow) Then Exit For

   Loop Until .Cells(rownum, 1).Value = "Laptop"
   endrow = rownum
   rownum = rownum + 1

   Worksheets("StartSheet").Range(startrow & ":" & endrow).Copy


   Sheets("Result").Select
   Range("A1").Select
   ActiveSheet.Paste


   Next rownum
   End With
   End Sub