Sub Perebor_1()
 Dim MSGForInputBox As String 'ïåðåìåííàÿ ôîðìèðóåò òåêñò äëÿ Application.InputBox
 Dim vRetVal 'äëÿ ïîëó÷åíèÿ âûáðàííîãî çíà÷åíèÿ ñ ôîðìû Application.InputBox è ïåðåâîäà â Znacheniye
 Dim currentwsh As Object 'Õðàíèì òåêóùèé ëèñò
 Dim kolvoznacheniy As Integer
 Dim Znacheniye As Single 'ïåðåìåííàÿ îòëàâëèâàåò ââåä¸ííîå ïîëüçîâàòåëåì çíà÷åíèå (áåð¸ò ñ vRetVal)
 Dim PromZnacheniye As Single 'ïðîìåæóòî÷íîå çíà÷åíèå äëÿ õðàíåíèÿ iFoundRng
 Dim ZnacheniyeLikeText As String 'ïðåîáðàçóåò èñêîìîå çíà÷åíèå â òåêñò â íóæíûé ôîðìàò
 Dim iFoundRng As Range 'ïåðåìåííàÿ èùåò ÿ÷åéêó ñ íóæíûì çíà÷åíèåì
 Dim StartPoint, EndPoint, StepPoint, PointPerebor As Integer
 Const AmericanDecimalSeparator = "."
 Application.ScreenUpdating = False
    'çàïðîñ ÷èñëà - Type:=1
    'âîçâðàùàåò ÷èñëî. Íå äàñò ââåñòè òåêñò, âûäàâ ñîîáùåíèå îá îøèáêå
    Set currentwsh = ActiveWorkbook.ActiveSheet
    If ((ActiveSheet.Cells(2, 1).Value = "F5") Or (ActiveSheet.Cells(2, 1).Value = "F4") Or (ActiveSheet.Cells(2, 1).Value = "F3") Or _
        (ActiveSheet.Cells(2, 1).Value = "F2") Or (ActiveSheet.Cells(2, 1).Value = "F1") Or (ActiveSheet.Cells(2, 1).Value = "F0") Or _
        (ActiveSheet.Cells(2, 1).Value = "ÂÑÅ")) Then
        'îáðàáîòàåì áàçîâîå ñîîáùåíèå äëÿ Application.InputBox
        MSGForInputBox = "Óêàæèòå ÷èñëî â äèàïàçîíå îò 1 äî 2"
        If ((ActiveSheet.Cells(2, 1).Value = "F5") Or (ActiveSheet.Cells(2, 1).Value = "ÂÑÅ")) _
            Then: MSGForInputBox = "Óêàæèòå ÷èñëî â äèàïàçîíå îò 1 äî 3"

AA:     vRetVal = Application.InputBox(MSGForInputBox, "Çàïðîñ äàííûõ", "", Type:=1)
        If vRetVal = False Then Exit Sub
        Znacheniye = vRetVal
        'ïðîâåä¸ì äîïîëíèòåëüíóþ ïðîâåðêó êîððåòíîñòè ââîäà çíà÷åíèÿ
        If (((Znacheniye < 1) Or (Znacheniye > 2)) And ((ActiveSheet.Cells(2, 1).Value <> "F5") And (ActiveSheet.Cells(2, 1).Value <> "ÂÑÅ"))) Then: GoTo AA
        If (((Znacheniye < 1) Or (Znacheniye > 3)) And ((ActiveSheet.Cells(2, 1).Value = "F5") Or (ActiveSheet.Cells(2, 1).Value = "ÂÑÅ"))) Then: GoTo AA
        'îêðóãëèì êîððåêòíî ââåä¸ííîå çíà÷åíèå äî 2-õ çíàêîâ ïîñëå çÿïÿòîé
        Znacheniye = Format(Znacheniye, "#,##0.00")
        Znacheniye = Round(Znacheniye, 2)
        Znacheniye = Format(Znacheniye, "#,##0.00")
        ZnacheniyeLikeText = Replace(CStr(Format(Znacheniye, "#,##0.00")), Application.DecimalSeparator, AmericanDecimalSeparator)
        a = Timer
        'Debug.Print ("Áóäåò îñóùåñòâë¸í ïîèñê çíà÷åíèÿ " & ZnacheniyeLikeText)
        
        'Î÷èñòèì ïîñëå ñî õíà÷åíèÿ äëÿ âûâîäà íîâûõ
        Rows("5:11000").Select
        Selection.Delete Shift:=xlUp
        ActiveSheet.Cells(2, 1).Select
        kolvoznacheniy = 0
        
        'ñîçäà¸ì ïåðåáîð, ãäå â çàâèñèìîñòè îò âûáîðà ïåðåáèðàþòñÿ ëèáî âñå ëèñòû, ëèáî êàêîé-òî êîíêðåòíûé
        If ActiveSheet.Cells(2, 1).Value <> "ÂÑÅ" Then
            StartPoint = CInt(Right(ActiveSheet.Cells(2, 1).Value, 1))
            EndPoinr = CInt(Right(ActiveSheet.Cells(2, 1).Value, 1))
            StepPoint = 1
        Else
            StartPoint = 0
            EndPoinr = 5
            StepPoint = 1
        End If
        
        'èùåì êîíêðåòíîå çíà÷åíèå íà îäíîì èëè âñåõ ëèñòàõ
        For PointPerebor = StartPoint To EndPoinr Step StepPoint
            'àêòèâèðóåì íóæíûé ëèñò
            ActiveWorkbook.Sheets("F" & PointPerebor).Activate
            With ActiveSheet.Range(Cells(3, 2), Cells(103, 102)) 'áåð¸ì äèàïàçîí, â êîòîðîì èñêàòü
            Set iFoundRng = .Find(What:=ZnacheniyeLikeText, LookIn:=xlValues) 'çàäà¸ì ïîèñê
            
            If Not iFoundRng Is Nothing Then
                firstAddress = iFoundRng.Address 'óêàçûâàåì ÿ÷åéêó ñ íà÷àëîì ïîèñêà
                Do
                        Debug.Print ("Íà ëèñòå " & "F" & PointPerebor & ", ÿ÷åéêà " & iFoundRng.Row & ": " & iFoundRng.Column & " c êîîðäèíàòîé " & _
                        ActiveSheet.Cells(iFoundRng.Row, 1).Value & " : " & ActiveSheet.Cells(2, iFoundRng.Column).Value)
                        'âûâîä çíà÷åíèé
                        currentwsh.Cells(6 + kolvoznacheniy, 1).Value = "F" & PointPerebor
                        currentwsh.Cells(6 + kolvoznacheniy, 2).Value = iFoundRng.Row
                        currentwsh.Cells(6 + kolvoznacheniy, 3).Value = iFoundRng.Column
                        currentwsh.Cells(6 + kolvoznacheniy, 4).Value = ActiveSheet.Cells(iFoundRng.Row, 1).Value * 1
                        currentwsh.Cells(6 + kolvoznacheniy, 5).Value = ActiveSheet.Cells(2, iFoundRng.Column).Value * 1
                        kolvoznacheniy = kolvoznacheniy + 1
                        Set iFoundRng = .FindNext(iFoundRng)
                Loop While Not iFoundRng Is Nothing And iFoundRng.Address <> firstAddress
            Else
                'Debug.Print "Íå íàéäåíî."
            End If
            End With
        Next PointPerebor
        
        Debug.Print ("Âñåãî íàéäåíî " & kolvoznacheniy & " çíà÷åíèé")
        'âåðíóëèñü íà èñõîäíóþ
        currentwsh.Activate
        ActiveSheet.Cells(2, 1).Select
    Else
        MsgBox ("Âû íè÷åãî íå Âûáðàëè - ìàêðîñ îñòàíîâëåí")
        Exit Sub
    End If
    Application.ScreenUpdating = True
    MsgBox Timer - a
End Sub