在 Excel 文件中搜索 2 个字符串，复制并粘贴到新工作表

Question

我是 VBA 的新手，正在尝试编写一个代码来搜索 Excel 工作表中的字符串。当它找到它（开始位置）时，搜索另一个字符串并找到它（结束位置）复制这两者之间的所有行并将它们复制到新工作表中。

被复制的每一行也有 3 列需要复制/粘贴。

我尝试修改此处的一些代码和 YouTube 上的一些代码，但没有任何运气。这是我到目前为止的代码。感谢您提供的任何帮助

Employee = Sheet1.Cells(5, 1)
TTI = Sheet1.Cells(3, 1)
Dim rng As Range
Dim Employee As String
Dim rownumber As Long

Set rng = Sheet1.Columns("A:A").Find(What:=Employee, _
    LookIn:=x1Formulas, LookAt:=x1Whole, SearchOrder:=x1byRows, _
    SearchDirection:=x1Next, MatchCase:=False, SearchFormat:=False)
    rownumber = rng.Row
    rng = Sheet1.Columns("rownumber,A:A").Find(What:=TTI, _
    LookIn:=x1Formulas, LookAt:=x1Whole, SearchOrder:=x1byRows, _
    SearchDirection:=x1Next, MatchCase:=False, SearchFormat:=False)
    rownumber2 = rng.Row

Sheet2.Cells(2, 1).String = Sheet.Cells("rownumber, 1:rownumber2, 1").String

当我尝试运行代码时，我得到的只是运行时错误

Answer 1

您可以使用下面的代码作为宏的模板，可能需​​要调整某些范围以满足您的需要。

Sub test()

    Dim iRowStart As Integer, iRowEnd As Integer, iCol As Integer

    iCol = 7

    iRowEnd = FindString("To", iCol)
    iRowStart = FindString("From", iCol)


    ActiveSheet.Range(Cells(iRowStart, iCol), Cells(iRowEnd, iCol)).Copy Destination:=Sheet2.Range("A2")
    ActiveSheet.Cells(iRowStart, 1).Select

End Sub


Function FindString(str As String, iCol As Integer) As Integer
    Dim c As Range
    Dim rSearch As Range

    Set rSearch = ActiveSheet.Columns(iCol)

    With rSearch
        Set c = .Find(str, LookIn:=xlValues)
        If Not c Is Nothing Then
            FindString = c.Row
        End If
    End With
End Function