Sub test()
    Dim dic1 As Object
    Dim dic2 As Object
    Dim i&, ikey, arr(), txt$
    
    Set dic1 = CreateObject("Scripting.Dictionary")
    Set dic2 = CreateObject("Scripting.Dictionary")
    arr = Лист1.UsedRange.Value
    For i = 2 To UBound(arr)
        txt = arr(i, 1)
        dic1.Item(txt) = arr(i, 2)
        dic2.Item(txt) = arr(i, 3)
    Next i
    
    For i = 2 To UBound(arr)
        txt = arr(i, 1)
        If Not IsEmpty(arr(i, 2)) Then dic1.Item(txt) = arr(i, 2)
        If Not IsEmpty(arr(i, 3)) Then dic2.Item(txt) = arr(i, 3)
    Next i
    With Лист2
        .[a2].Resize(dic1.Count) = Application.Transpose(dic1.keys)
        .[b2].Resize(dic1.Count) = Application.Transpose(dic1.items)
        .[c2].Resize(dic1.Count) = Application.Transpose(dic2.items)
    End With
End Sub