Немного нестандартное добавление данных

[strannick]

Добрый день, уважаемые форумчане!
Еженедельно поступают данные (в примере лист 1). Записи (данные) по четырем разным клиентам за одну дату идут одна под другой. Структура таблицы именно такая (выгрузка). Эти данные необходимо перебросить (добавить) в накопительный файл со структурой таблицы как в примере на листе 2. То есть, дата должна быть один раз, а данные по клиенту (суммы) заносится каждые в свой столбец. Причем, тут клиента 3 (три столбца). Четвертого не надо учитывать, просто пропускать. Обращаю внимание, что заголовки столбцов менять нельзя. Вот такая свистопляска. Чего-то я видно перегрелся...)))))))))
Но все равно, заранее спасибо!!!

[nilem]

Sub ertert()
Dim x, arr(), y(), i&, j&
arr = [{"Петя","Гриша","Вася"}]
With Sheets("Лист1")
    x = .Range("C1:F" & .Cells(Rows.Count, 3).End(xlUp).Row).Value
End With
With CreateObject("Scripting.Dictionary")
    .CompareMode = 1
    For i = 2 To UBound(x)
        If Not .Exists(x(i, 2)) Then
            For j = 1 To UBound(arr)
                If InStr(x(i, 2), arr(j)) Then .Item(x(i, 2)) = j + 1: Exit For
            Next
        End If
    Next i

    ReDim y(1 To UBound(x), 1 To UBound(arr) + 1): j = 0
    For i = 2 To UBound(x)
        If x(i, 1) <> x(i - 1, 1) Then j = j + 1: y(j, 1) = x(i, 1)
        If .Exists(x(i, 2)) Then y(j, .Item(x(i, 2))) = x(i, 4)
    Next i
End With

Sheets("Лист2").Cells(Rows.Count, 1).End(xlUp)(2, 1).Resize(j, UBound(y, 2)).Value = y()
End Sub

[strannick]

Спасибо огромное!!! Все перекидывается как надо.

[strannick]

Возник еще один вопросик. Если необходимо раскидывать не все данных из источника, а только 5 последних строк, это надо так?

x = .Range("C1:F" & .Cells(Rows.Count-5, 3).End(xlUp).Row).Value

У меня что-то не сработало. Наверное, не так.

[ShAM66]

Наверное, так:

x = .Range("C" & .Cells(Rows.Count, 3).End(xlUp).Row - 5 & ":F" & .Cells(Rows.Count, 3).End(xlUp).Row).Value

[strannick]

Да, точно. Так работает. Спасибо.