Excel VBA Макросы: Как вставить ячейки с формулами в каждый лист книги по условию?

[Alejo]

Можно ли автоматически вставить ячейки с формулами (Лист "Формула" E3:AB3) в строки каждого листа книги, если в столбце "C" есть текст "мвт" или "мвар"? Вставлять нужно со столбца "E".

Эту задачу нужно сделать не один раз, а нужно делать периодически.

[вложение удалено администратором]

[Администратор]

Вам это надо делать периодически или один раз?

[Alejo]

периодически

[Администратор]

Вверху модуля вставьте эти строки:
Option Explicit
Option Compare Text
Option Base 1

Макрос

Sub Макрос()
   
    Dim sh_src As Worksheet, sh_res As Worksheet
    Dim ColC()
    Dim lr As Long, i As Long, ii As Long
   
   
    ' Отключение монитора и формул, чтобы ускорить макрос.
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
   
    '1. Присваиваем имя "sh_src" листу, на котором находятся формулы.
    Set sh_src = Worksheets("Формула")
   
    '2. Копируем строку с формулами.
    sh_src.Range("E3:AB3").Copy
   
    '3. Двигаемся по листам с третьего по последний.
    For i = 3 To Worksheets.Count
       
        '1) Присваиваем листу имя "sh_res".
        Set sh_res = Worksheets(i)
       
        '2) Копируем данные из столбца C в vba-массив - с vba-массивом макрос быстрее
            ' работает, чем с ячейками.
        ' Поиск последней строки.
            ' End не ищет в скрытых строках.
        lr = sh_res.Cells(sh_res.Rows.Count, "C").End(xlUp).Row
        ' Копирование данных в массив.
        ColC() = sh_res.Range("C1:C" & lr).Value
       
        '3) Вставляем скопированное в нужные строки.
        ' Двигаемся по строкам столбца C со строки 5 и по последнюю.
        For ii = 5 To UBound(ColC)
            ' Смотрим содержимое ячейки.
            Select Case ColC(ii, 1)
                ' Если в ячейке заданный текст.
                Case "мвт", "мвар"
                    ' Вставляем скопированное.
                    sh_res.Cells(ii, "E").PasteSpecial xlPasteFormulas
            End Select
        Next ii
       
    Next i
   
    '4. Выход из режима копирования.
    Application.CutCopyMode = False
   
    ' Включение событий.
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
   
    '5. Сообщение.
    MsgBox "Готово.", vbInformation
   
End Sub

[свернуть]

[Alejo]

Спасибо!!!