Private Sub CommandButton1_Click()
    Dim cell As Range
    Dim value As Double
    numCell = 2
    Set rgData = Range("B2:B11")
    s = Replace(TextBox1.value, ".", ",")
    value = CDbl(s)
    
    Set myList = Worksheets.Add(After:=Worksheets(Worksheets.Count))
    myList.Cells(1, 1) = Sheets("Лист1").Cells(1, 1)
    myList.Cells(1, 2) = Sheets("Лист1").Cells(1, 2)
    
    For Each cell In rgData
        If cell.value > value Then
            myList.Cells(numCell, 1) = Sheets("Лист1").Cells(cell.Row, cell.Column - 1)
            myList.Cells(numCell, 2) = Sheets("Лист1").Cells(cell.Row, cell.Column)
            numCell = numCell + 1
        End If
    Next
    UserForm1.Hide
End Sub

Sub RRR()

    Shapka = "B2:C3"        ' Область шапки
    RFil = "C3"             ' Ячейка с фильтром по цене
    RName = "B3"            ' Ячейка с шапкой с названиями (товар обязательно должен иметь название)
    Info = "C1"             ' Ячейка куда запишется значение фильтра в выходной форме
    
    NewList = "Отобрано"    ' Имя листа, если выборка делается на один и тот же лист
    
    R1 = Mid(Shapka, 1, InStr(1, Shapka, CStr(Range(Shapka).Row) + ":") - 1) + "1"
    
    ACol = Replace(Shapka, CStr(Range(Shapka).Row) + ":", ":")
    FRow = Range(Shapka).Cells(Range(Shapka).Count).Row
    ACol = Replace(ACol, CStr(FRow), "")
    
    iFil = 1 + Range(RFil).Column - Range(Shapka).Column ' Номер столбца в шапке для фильтра
    
    iReestr = ActiveSheet.Index
        
    CGod = InputBox("Введите цену товара", "Отбор товара не более указанной цены")
    
    If CGod = "" Then Exit Sub
    If Not IsNumeric(CGod) Then
        MsgBox "Введенное значение цены" + vbCrLf + vbCrLf + """" + CGod + """" + vbCrLf + vbCrLf + "не число"
        Exit Sub
    End If
    
    God = CCur(CGod)
    If God < 0 Then
        MsgBox "Введенное значение цены" + vbCrLf + vbCrLf + """" + CGod + """" + vbCrLf + vbCrLf + "не корректно"
        Exit Sub
    End If
    
    'NewList = CGod              ' Закомментировать, чтобы выборка делалась на один лист
                                ' Иначе выборка для каждой цены будет на отдельном листе со значением цены
    Application.DisplayAlerts = False
    On Error Resume Next
        Sheets(NewList).Delete
    On Error GoTo 0
    Application.DisplayAlerts = True
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = NewList
    
    iNew = ActiveSheet.Index
    
    Sheets(iReestr).Select
    Columns(ACol).Copy
    
    Sheets(iNew).Select
    Range(R1).Select
    Range(R1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        
    Sheets(iReestr).Select
    AFiltr = Replace(ACol, ":", CStr(Range(Shapka).Row + 1) + ":") + CStr(Range(RName).End(xlDown).Row)
    
    ActiveSheet.Range(AFiltr).AutoFilter Field:=iFil, Criteria1:="<=" + Replace(CGod, ",", "."), Operator:=xlAnd

    Columns(ACol).Copy
    Sheets(iNew).Select
    Range(R1).Select
    ActiveSheet.Paste
    Sheets(iReestr).Select
    Selection.AutoFilter
    Range(R1).Select
    Sheets(iNew).Select
    Range(Info) = "<=" + CGod
    Range(Info).Select
    
End Sub