Добавление строк с меняющимся массивом данных по условию в ячейке

[Alexsandrr]

Уважаемые программисты очень нужен макрос в VBA.
Необходимо в таблице (Задача) по значениям ячеек в столбце "C" (ОргЕдинц) определить кол-во положенных вещей для человека в "Исходных данных" столбцы A:B (Лист2), затем добавить нужное кол-во строк в таблице (Задача) ниже от проверяемой ячейки в столбце "С" (нужное кол-во строк для добавления определяется кол-вом вещей соответствующей ОргЕдинице). Далее скопировать в столбце "B" на Лист2 необходимые вещи и вставить справа от должности соответствующей ОргЕдинице на Лист1. И так по всем ОргЕдиницам.

[Aleksandr H.]

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

очень нужен макрос в VBA.

За деньги?

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

Далее скопировать в столбце "P"

в Р нету ничего

[Alexsandrr]

Похоже сложный вопрос...

[Alexsandrr]

в Р нету ничего[/QUOTE]

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

[Aleksandr H.]

вот идея. пилите под себя

[Alexsandrr]

Можно Вас попросить подправить макрос, чтобы изменялась сама таблица "Задача"?

[Aleksandr H.]

Sub Thread1685816()
    Dim sh2 As Worksheet
    Dim sh As Worksheet
    Dim r, curR, rAdd As Integer, curExtR
    Dim findRow As Range
    Dim rng As Range
    Application.ScreenUpdating = False
    Set sh = Sheets("Ëčńň3")
    Set sh2 = Sheets("Ëčńň2")
    r = sh.Range("A5000").End(xlUp).Row
    curR = 3
    Application.CutCopyMode = False
    Do While curR <= sh.Range("A5000").End(xlUp).Row
        rAdd = WorksheetFunction.CountIf(sh2.Range("A:A"), sh.Cells(curR, "C"))
        If rAdd > 0 Then
            curExtR = curR + rAdd - 1
            sh.Rows(curR + 1 & ":" & curExtR).Insert shift:=xlDown
            Set findRow = sh2.Range("A:A").Find(What:=sh.Cells(curR, "C"), LookIn:=xlValues, lookat:=xlWhole)
            Set rng = findRow.Resize(rAdd, 1).Offset(0, 1)
            sh.Range("E" & curR).Resize(rAdd, 1).Value = rng.Value
            curR = curExtR + 1
        Else
            curR = curR + 1
        End If
    Loop
    
    Set sh = Nothing: Set sh2 = Nothing
    Application.ScreenUpdating = True
End Sub

[Alexsandrr]

Все работает, большое спасибо!