Seçili doğrulamaya göre tablodaki diğer hücreleri doldurma yardım

[dejavuxer]

Merhaba üstadlar
Benim sorunum şu

Ekteki iller sayfasına I1 hücresinde seçmiş olduğum değere göre tablonun doldurulması

Değer değiştiğinde tablonunda değişmesi

Düşeyara ile yağmaya çalıştım ama yapadım lütfen yardım

Şimdiden teşekkürler

 

[Necdet]

Merhaba,

Siz her ne kadar fonksiyonlarla çözüm istemiş olsanızda şimdiden alternatif olarak VBA olsun istedim.

Fonksiyonla çözümü arkadaşlar vereceklerdir kesin.

Aşağıdaki kodların iller sayfasının kod bölümüne kopyalayıp deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Intersect(Target, [I1]) Is Nothing Then Exit Sub
    
    Dim i   As Long, _
        c   As Range, _
        Adr As String, _
        shb As Worksheet
    
    Set shb = Sheets("Bilgi")
    Application.ScreenUpdating = False
    i = Cells(Rows.Count, "A").End(3).Row
    If i < 2 Then i = 2
    Range("A2:F" & i).ClearContents
    
    i = 1
    With shb.Range("M:M")
        Set c = .Find([I1], LookIn:=xlValues)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
                i = i + 1
                Cells(i, "A") = shb.Cells(c.Row, "A")
                Cells(i, "B") = shb.Cells(c.Row, "E")
                Cells(i, "C") = shb.Cells(c.Row, "F")
                Cells(i, "D") = shb.Cells(c.Row, "G")
                Cells(i, "E") = shb.Cells(c.Row, "B")
                Cells(i, "F") = shb.Cells(c.Row, "M")
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
    End With
    
    Application.ScreenUpdating = True
    
End Sub

 

[dejavuxer]

Necdet bey çok teşekkür ederim çok güzel oldu.