Function co(s As String, rf As Range, n%, Optional nDel% = 3, Optional k% = 1)
Dim r As Range, mF, ii&, st&, f&
ReDim mF(0 To 0)
With rf.Parent
    Set r = rf.Find(What:=s, After:=.Cells(1, 1), LookIn:=xlFormulas _
            , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
    
    Do Until Len(r.Offset(I, 2)) = 0
        mF(I) = r.Offset(I, 3) & " " & r.Offset(I, 2) & " " & r.Offset(I, 4) * k & " шт."
        I = I + 1
        ReDim Preserve mF(I)
    Loop
    I = I - 1
End With

If n > I + 1 Then co = "": Exit Function
If n = 1 Then st = 0 Else st = Int(I / nDel * (n - 1)) + 1
If n = nDel Or n > I Then f = I Else f = Int(I / nDel * (n))

For I = st To f - 1
    co = co & mF(I) & vbLf '", "
Next
co = co & mF(f)
End Function