Скопировать формулу при условии

[amadeus017]

Доброго времени суток, уважаемые форумчане!

Обращаюсь к вам за помощью при создании макроса, который бы при нахождении значения "Итого" в столбце "A1:A500", формулу из соседней ячейки "B", той строки где "Итого", копировал и вставлял в ячейки "D:J" и "O:S", в этой же строке.

[IgorGO]

проделайте операции вручную
запишите рекордером действия
будет Вам макрос

удачи!

[amadeus017]

Я именно так и сделал. Запустил рекордер, сделал все манипуляции и остановил макрос.
Однако, если уменьшать или увеличивать количество строк, думаю, что мною записанный макрос, не пойдет(...
В приведенном мною примере, количество строк, одинаковое, вот и хотел привязаться в значению "Итого", которое стоит в графах "A" и "L".

[Aleksandr H.]

Сообщение от amadeus017

Запустил рекордер, сделал все манипуляции и остановил макрос.

поделитесь кодом. Что-там?

[amadeus017]

Сообщение от Aleksandr H.

поделитесь кодом. Что-там?

Таблица больше, чем в приведенном примере, и имеет, как я уже писал, разный размер.

Sub Итоги()
'
' Итоги Макрос

'
ActiveWindow.SmallScroll Down:=-15
Range("B22").Select
Selection.Copy
Range("D22:I22,O22:S22").Select
Range("O22").Activate
ActiveSheet.Paste
Application.CutCopyMode = False
' ActiveWindow.SmallScroll Down:=18
Range("B42").Select
Selection.Copy
Range("D42:I42,O42:S42").Select
Range("O42").Activate
ActiveSheet.Paste
Application.CutCopyMode = False
' ActiveWindow.SmallScroll Down:=18
Range("B63").Select
Selection.Copy
Range("D63:I63,O63:S63").Select
Range("O63").Activate
ActiveSheet.Paste
Application.CutCopyMode = False
Range("S68").Select
Selection.Copy
Range("O68:R68").Select
ActiveSheet.Paste
Application.CutCopyMode = False
' ActiveWindow.SmallScroll Down:=24
Range("B87").Select
Selection.Copy
Range("D87:I87,O87:S87").Select
Range("O87").Activate
ActiveSheet.Paste
Application.CutCopyMode = False
' ActiveWindow.SmallScroll Down:=33
Range("B126").Select
Selection.Copy
Range("D126:I126,O126:S126").Select
Range("O126").Activate
ActiveSheet.Paste
Application.CutCopyMode = False
' ActiveWindow.SmallScroll Down:=24
Range("B146").Select
Selection.Copy
Range("D146:I146,O146:S146").Select
Range("O146").Activate
ActiveSheet.Paste
Application.CutCopyMode = False
' ActiveWindow.SmallScroll Down:=18
Range("B167").Select
Selection.Copy
Range("D167:I167,O167:S167").Select
Range("O167").Activate
ActiveSheet.Paste
Application.CutCopyMode = False
Range("B170").Select
Selection.Copy
Range("D170:I170,O170:S170").Select
Range("O170").Activate
ActiveSheet.Paste
Application.CutCopyMode = False
Range("B172").Select
Selection.Copy
Range("D172:I172,O172:S172").Select
Range("O172").Activate
ActiveSheet.Paste
Application.CutCopyMode = False

ActiveWindow.SmallScroll Down:=-170
Range("A4").Select
End Sub

[IgorGO]

Sub InsSumm()
  Dim r As Long
  r = WorksheetFunction.Match("Итого", Columns(1), 0)
  Cells(r, 2).Copy Cells(r, 4).Resize(1, 7)
  Cells(r, 15).Resize(1, 5).Paste
End Sub

[amadeus017]

IgorGO
Спасибо за код!
Код работает, но только на первой таблице, в других таблицах (ниже под ней), данные не поменялись (сумма не посчитана).

[IgorGO]

меня это ни сколько не удивляет.
надо полагать, что о существовании на листе еще некоторого количества таблиц догадывались все, кроме меня

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