Soru Liste seçimine göre özet oluşturma

[ubyz1]

Merhaba arkadaşlar,
Linkteki dosyadaki şekilde bir listem var. G2'deki listeden seçtiğim veriye göre örnekteki şekilde özet oluşturmasını istiyorum.
Nasıl yapabilirim, yardımcı olur musunuz?

https://www.dosyaupload.com/noMI

 

[Orion1]

Dosyanız linktedir.

DOSYAYI INDIR

Private Sub Worksheet_Change(ByVal Target As Range)
Dim sonsat As Long, k As Range, adr As String, sat As Long
If Intersect(Target, [G2]) Is Nothing Then Exit Sub
Range("H2:J" & Rows.Count).ClearContents
sonsat = Cells(Rows.Count, "C").End(xlUp).Row
sat = 2
Set k = Range("C1:C" & sonsat).Find(Target.Value, , xlValues, xlWhole)
If Not k Is Nothing Then
    adr = k.Address
    Do
        Cells(sat, "I").Value = Cells(k.Row, "A").Value
        Cells(sat, "J").Value = Cells(k.Row, "D").Value
        sat = sat + 1
        Set k = Range("C1:c" & sonsat).FindNext(k)
    Loop While Not k Is Nothing And k.Address <> adr
End If
MsgBox "İşlem bitti."

End Sub

 

[ubyz1]

Cevap için çok teşekkürler, istediğim şekilde çalıştı.
Fakat ben makrolara çok hakim değilim. Daha basit olarak formülle yapma şansımız var mı?