Перенос данных с ячейки в ячейку по условию

[Perova irina]

Доброе время суток уважаемые!
Все действия на одном листе.
Необходимо переносить автоматически данные.
В ручную муторно и долго. Помогите решить задачку.
В прикрепленном файле:
1 таблица - как выгружается
2 таблица - как в итоге должно получиться
Спасибо.

[gling]

Можно так попробовать.

[Perova irina]

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

Можно так попробовать.

Спасибо за участие, попробую применить и пощелкать на большом массиве.

[Perova irina]

не...не получается, не переносит...
точнее переносит, но не то, что нужно

[gling]

В файле два варианта, оба не правильно переносят? Может в реальном файле фамилия не только Иванов?

[Perova irina]

Там не только Иванов, но есть еще Петров, Сидоров и еще 11 человек...
А что тут через личку общения не предусмотрено?

[Perova irina]

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

В файле два варианта, оба не правильно переносят? Может в реальном файле фамилия не только Иванов?

Проблема 1 варианта:
Отдельно прописывать 1;2;3 и т.д. на 300-400 строк - не вижу смысла, т.к.
увеличивается тем самым кликоманство

как выслать файл?

[gling]

Может тогда так?

[Perova irina]

Дорогой друг! Спасибки конечно, но увы...
У Вас добавлен столбец Н, который в свою очередь зашит в формулу...
если убирать Н - то формула не считает
если не убирать Н, а прописывать вручную, то что там зашито,
то по времени что прописывать, что перетягивать цифиры одинаково...
экономию трудозатрат не вижу?

Спасибо еще раз, но не той дорогой мы пошли, надо искать другое решение...

[Hugo121]

Вариант без перемещений макросом:

Sub tt()
    Dim a(), i&, ii&
    Application.ScreenUpdating = False
    
    a = [a1].CurrentRegion.Value
    With CreateObject("scripting.dictionary"): .comparemode = 1
        For i = 2 To UBound(a)
            t = a(i, 1) & "|" & a(i, 2)
            If Not .exists(t) Then .Add t, New Collection
            .Item(t).Add a(i, 3)
        Next

        Set Sh = Workbooks.Add.Sheets(1)
        Sh.Cells(1) = "Ф.И.О."
        Sh.Cells(2) = "Вход"
        Sh.Cells(3) = "Выход"
        Sh.Cells(4) = "Время нахождения"
        Sh.Cells(5) = "Время перемещения"
        ii = 1
        For Each el In .keys
            If InStr(el, "|Вход") Then
                For i = 1 To .Item(el).Count
                    ii = ii + 1
                    Sh.Cells(ii, 1) = Replace(el, "|Вход", "")
                    Sh.Cells(ii, 2) = .Item(el)(i)
                    Sh.Cells(ii, 3) = .Item(Replace(el, "|Вход", "|Выход"))(i)
                    Sh.Cells(ii, 4).NumberFormat = "[$-F400]h:mm:ss AM/PM"
                    Sh.Cells(ii, 4) = "=C" & ii & "-B" & ii
                Next
            End If
        Next
    End With
    Sh.UsedRange.Columns.AutoFit

    Application.ScreenUpdating = True
End Sub