Использование цикла в .find

Set y = .Find(chto,,xlValues,xlWhole)

'n = Mid(y.Address, (InStr(2, y.Address, "$") + 1)) 'получаю номер искомой строки
'Лучше получать номер строки так:
n = y.Row

'For i = 1 To 13000
For i = 1 To sht.Cells(sht.rows.count,7).End(xlUp).row

Sub sootv()
    Dim n
    Dim i As Long, lColor As Long
    Dim chto
    Dim sht As Worksheet, ipr As Worksheet
    Dim y As Range
    Set sht = Workbooks("Копия.xlsm").Worksheets("База")
    Set ipr = Workbooks("Копия.xlsm").Worksheets("Лист1")
    lColor = sht.Cells(44, 3).Interior.ColorIndex
    For i = 1 To sht.Cells(sht.Rows.Count, 7).End(xlUp).Row
        If sht.Cells(i, 3).Interior.ColorIndex = lColor Then    'соответствие заливки шаблону
            chto = sht.Cells(i, 7).Value
            With ipr
                Set y = .Columns(6).Find(chto, , xlValues, xlWhole)
                If Not y Is Nothing Then
                    n = y.Row    'получаю номер искомой строки
                    sht.Cells(i, 46).Value = ipr.Cells(n, 91).Value
                    sht.Cells(i, 47).Value = ipr.Cells(n, 93).Value
                    sht.Cells(i, 48).Value = ipr.Cells(n, 94).Value
                    sht.Cells(i, 49).Value = ipr.Cells(n, 95).Value
                    sht.Cells(i, 50).Value = ipr.Cells(n, 96).Value
                End If
            End With
        End If
    Next i
End Sub

chto = Mid(sht.Cells(i, 7).Value,1,254) & "*"

Set sht = Workbooks("Book.xlsm").Worksheets("Sheet1")

Sub sootv_arr()
    Dim avArrFindIn, li As Long
    Dim avTmpArr(1 To 5)
    Dim i As Long, lColor As Long
    Dim chto
    Dim sht As Worksheet
    Set wsFindIn = Workbooks("Копия.xlsm").Worksheets("База")
    'заносим данные листа в массив
    avArrFindIn = Workbooks("копия.xlsm").Worksheets("Лист1").UsedRange.Value
    For i = 1 To sht.Cells(sht.Rows.Count, 7).End(xlUp).Row
        If sht.Cells(i, 3).Interior.ColorIndex = lColor Then 'соответствие заливки шаблону
            chto = sht.Cells(i, 7).Value
            For li = LBound(avArrFindIn, 1) To UBound(avArrFindIn, 1)
                If chto = avArrFindIn(li, 6) Then
                'заносим во временый массив данные
                    avTmpArr(1) = avArrFindIn(li, 91)
                    avTmpArr(2) = avArrFindIn(li, 93)
                    avTmpArr(3) = avArrFindIn(li, 94)
                    avTmpArr(4) = avArrFindIn(li, 95)
                    avTmpArr(5) = avArrFindIn(li, 96)
                    'записываем данные из массива на лист
                    sht.Cells(i, 46).Resize(, 5).Value = avTmpArr
                    Exit For
                End If
            Next li
        End If
    Next i
End Sub