Diğer Sayfadan verileri süzerek alma

[kontto]

İyi günler arkadaşlar. Ekte gönderdiğim çalışma kitabındaki veri sayfasına girilen veriyi diğer sayfadan iller bazında süzerek alabilirmiyiz. Birde sayım sayfasında imleci nereye götürürsek götürelim satır ve sütun olarak renk verebilirmiyiz.

 

[Orion1]

Dosyanız ektedir.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim sonsut As Integer, i As Long, k As Range
Dim sh As Worksheet, sat2 As Long, sat3 As Long
If Intersect(Target, [C3]) Is Nothing Then Exit Sub
On Error Resume Next
Set sh = Sheets("sayım")
sat2 = sh.Cells(65536, "D").End(xlUp).Row
sonsut = Cells(4, "IV").End(xlToLeft).Column
Range(Cells(6, 3), Cells(6, sonsut)).ClearContents
If Target.Value = "" Then Exit Sub
If sonsut < 4 Then Exit Sub
If sat2 < 5 Then Exit Sub
Set k = sh.Range("D5:D" & sat2).Find(Target.Value, , xlValues, xlWhole)
If Not k Is Nothing Then
    sat3 = k.Row
    Else
    Exit Sub
End If
For i = 4 To sonsut
    Set k = sh.Range("J3:IV3").Find(Cells(4, i).Value, , xlValues, xlWhole)
    If Not k Is Nothing Then
        Cells(6, i).Value = sh.Cells(sat3, k.Column).Value
    End If
Next i
End Sub

 

[kontto]

Yardımınız için teşekkür ederim ama. Göndermiş olduğum excel dosyasının içinde nasıl olmasını istediğimi yazmıştım yani göndermiş olduğunuz dosya tam anlamıyla işimi görmüyor.