Search a string and make a worksheet with the searched name will rows

My requirements are simple. I have a huge worksheet with hundreds of rows and columns. I need to search a string or a part-of-the string, copy all rows which contain that part-of-string to a new worksheet and name the worksheet as the name of the string or sub-string.
I tried the following code:

Sub try()

    Dim strLastRow As String
    Dim rngC As Range
    Dim strToFind As String, FirstAddress As String
    Dim MySheetName As String
    Dim wSht As Worksheet
    Dim wSht1 As Worksheet
    Dim rngtest As String
    Application.ScreenUpdating = False
    strToFind = InputBox("Enter the STring to find")
        
    Set wSht = Worksheets("Sheet2")
        
    With ActiveSheet.Range("B1:B2000")
        Set rngC = .Find(what:=strToFind, LookAt:=xlPart)
            If Not rngC Is Nothing Then
                FirstAddress = rngC.Address
                Do
                    strLastRow = Worksheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Row + 1
                    rngC.EntireRow.Copy wSht.Cells(strLastRow, 1)
                    Set rngC = .FindNext(rngC)
                Loop While Not rngC Is Nothing And rngC.Address <> FirstAddress
            End If
    End With
    On Error Resume Next
    MySheetName = strToFind
    Worksheets(MySheetName).Delete
    Err.Clear
    Application.DisplayAlerts = True
    Worksheets.Add.Name = MySheetName
    
    Sheets("Sheet2").Range("A1:B2000").Copy
    Sheets(MySheetName).Activate
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
    Sheets("Sheet2").Cells.ClearContents
        
    MsgBox ("Finished")
    
End Sub

The code works in excel 2010 but does not work in 2007. And it does not work for parts of string.
My columns are like this_midas_2050, that_midas_2040 etc.
I need to seach for midas in the worksheet and create a worksheet named midas.
Thanks a lot in advance