Знаете, я не занимался никогда никаким языком программирования и меня искренне поражает как вы можете спокойно написать код, который я пытаюсь написать в течение месяца. Благодарю за помощь и хорошее чувство юмора)

Запрос "вынос числа" наиболее задаваемый, нежели извлечение. Так тему больше людей увидит, но хотите извлечение-пожалуйста.
Sergey Stoyanov спасибо еще раз

Добрый день, уважаемые знатоки. Помогите ,пожалуйста. Есть таблицы ,в которых одними из строчек являются масса и объем. Задача: Вынести в колонки L и M только значения объема и массы. Проблема: Масса и объем выносятся только в первой табличке, а на последующие(на текущем листе) макрос не распространяется. Как сделать так, чтобы макрос искал ключевые слова и выносил значения из ячеек по всему листу?



Sub Макрос1()
Dim rFoundRng As Range
   Dim sTSearch As String
   Dim qFoundRng As Range
   Dim sTS As String
   sTSearch = "Объем"
   k_ = _
       "=LOOKUP(2^64,--LEFT(MID(RC[-11]&0,MIN(FIND({0,1,2,3,4,5,6,7,8,9},RC[-11]&123456789)),15),{1,2,3,4,5,6,7,8,9,10,11,12,13,14,15}))"
   Set rFoundRng = Rows.Find(sTSearch, , xlFormulas, xlPart)
   r_ = rFoundRng.Row
   If Not rFoundRng Is Nothing Then
       Range("L" & r_) = k_
   Else
       MsgBox "Ничего нет"
       Exit Sub
   End If
   sTS = "Масса"
   s_ = _
       "=LOOKUP(2^64,--LEFT(MID(R[1]C[-12]&""_0"",MIN(FIND({0,1,2,3,4,5,6,7,8,9},R[1]C[-12]&""_0123456789"")),15), {1,2,3,4,5,6,7,8,9,10,11,12,13,14,15}))"
   Set qFoundRng = Rows.Find(sTS, , xlFormulas, xlPart)
   q_ = qFoundRng.Row
   If Not rFoundRng Is Nothing Then
       Range("M" & q_ - 1) = s_
   Else
       MsgBox "Ничего нет"
       Exit Sub
   End If
End Sub

Вынос числа из текста с определенным словом

Уважаемые модераторы, как поменять тему?

2 момента которые хотел бы уточнить.
Я не знаю как поменять тему,при нажатии на кнопку изменить тему поменять невозможно.
Тему выбрал на подобии Функция ПОИСК от автора chelovekov81. В его теме модераторы не нашли никакой ошибки,поэтому решил повторить.

Сергей, чудесная формула, благодарю вас

Доброго утречка, уважаемые знатоки. Помогите решить проблему, всю голову сломал.
Суть следующая: необходимо вынести числа из строчек с объемом и массой в ячейки L4 и M4 соответственно. Проблема в том,что если объем всегда корректно выносится, то масса через раз (а то и чаще) выдает ошибку. В чем ошибка?
=ЕСЛИ(ЕЧИСЛО(ПОИСК("Объем";A4;1));ПРОСМОТР(2^64;--ЛЕВСИМВ(ПСТР(A4&0;МИН(НАЙТИ({0;1;2;3;4;5;6;7;8;9};A4&123456789));15); {1;2;3;4;5;6;7;8;9;10;11;12;13;14;15}));"")
=ЕСЛИ(ЕЧИСЛО(ПОИСК("Масса";A5;1));ПРОСМОТР(2^64;--ЛЕВСИМВ(ПСТР(A5&0;МИН(НАЙТИ({0;1;2;3;4;5;6;7;8;9};A5&123456789));15); {1;2;3;4;5;6;7;8;9;10;11;12;13;14;15})); "")

В отдельной

Может можно как-то сделать, чтобы он просто на текущий лист ссылался?

Даже в том коде, который вы написали выдает ту же ошибку. При этом я проверил,на всякий случай взял имя листа прямо с кода и переименовал лист. Ему все равно subscript out of range

Проблема в том, что он как раз есть

Уважаемые знатоки, приветствую. Помогите, пожалуйста, решить проблему
Пытаюсь написать код, который будет искать слово Объем и Масса, а затем выносить справа от этих ячеек значение собственно массы и объема.
Однако, постоянно вылезает ошибка supscript out of range и ссылается на строчку с With ThisWorkbook.Worksheets.


Sub Макрос1()
Dim myPhrase As Variant, myCell As Range, maya As Variant, yacheyka As Range
Range("L4").FormulaR1C1Local = "=ПРОСМОТР(2^64;--ЛЕВСИМВ(ПСТР(A4&""0"";МИН(НАЙТИ({0;1;2;3;4;5;6;7;8;9};A4&""0123456789""));15); {1;2;3;4;5;6;7;8;9;10;11;12;13;14;15}))"
Range("M4").FormulaR1C1Local = "=ПРОСМОТР(2^64;--ЛЕВСИМВ(ПСТР(A5&""0"";МИН(НАЙТИ({0;1;2;3;4;5;6;7;8;9};A5&""0123456789""));15); {1;2;3;4;5;6;7;8;9;10;11;12;13;14;15}))"
myPhrase = "Объем"
Set myCell = Range("A1:I200").Find(myPhrase)
If Not myCell Is Nothing Then
With ThisWorkbook.Worksheets("RDBMergeSheet")
Range("L4").Select
   Selection.Copy
   Range(myCell.Row, "L").Select
   ActiveSheet.Paste
   End With
End If
maya = "Масса"
Set yacheyka = Range("A1:I200").Find(maya)
If Not yacheyka Is Nothing Then
With ThisWorkbook.Worksheets("RDBMergeSheet")
Range("M4").Select
   Selection.Copy
   Range(yacheyka.Row, "L").Select
   ActiveSheet.Paste
   End With
   End If
End Sub