Sayfalarda Üst Bilgi Oluşturmak

[iplikci_80]

Arkadaşlar EK 'te gönderdiğim çalışmanın VERİ TABANI sekmesindeki kod I sütunundaki herhangi bir değere tıklandığında o değere ait bilgilerin LİSTE sekmesinde listelenmesini sağlıyor. Burada yapmak istediğim şey örneğin ŞUBE değeri tıklandığında bu değere ait bilgileri listeledikten sonra LİSTE sayfasının üst bilgi kısmında " ŞUBE PERSONEL LİSTESİ" veya "FABRİKA PERSONEL LİSTESİ" gibi üst bilgi oluşturma istiyorum. Bu konuda yardımlarınız bekliyorum.

 

[hamitcan]

VERİTABANI sayfasındaki kodunuzu aşağıdaki ile değiştirin.

 Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("I:I")) Is Nothing Then Exit Sub
    Dim erb As Range
    Sayfa2.Range("B2:K65536").ClearContents
    With Sayfa1
        For Each erb In .Range("I5:I" & .Range("I65536").End(3).Row)
            If Target.Value = erb.Value Then
                Sayfa2.Range("C65536").End(3)(2, 1) = .Cells(erb.Row, "B")
                Sayfa2.Range("D65536").End(3)(2, 1) = .Cells(erb.Row, "E")
                Sayfa2.Range("E65536").End(3)(2, 1) = .Cells(erb.Row, "F")
                Sayfa2.Range("H65536").End(3)(2, 1) = .Cells(erb.Row, "D")
                Sayfa2.Range("G65536").End(3)(2, 1) = .Cells(erb.Row, "C")
                Sayfa2.Range("I65536").End(3)(2, 1) = .Cells(erb.Row, "L")
                Sayfa2.Range("F65536").End(3)(2, 1) = .Cells(erb.Row, "I")
            End If
        Next erb
        End With
    Set erb = Nothing
    Set s1 = ThisWorkbook.Worksheets("liste")
For i = 2 To s1.Range("c65536").End(xlUp).Row
s1.Cells(i, 2) = i - 1
Next i
    With Sheets("LİSTE").PageSetup
     If Target.Text = "ŞUBE" Then
        .CenterHeader = "&""-,Kalın""&24ŞUBE PERSONEL LİSTESİ" & Chr(10) & ""
     ElseIf Target.Text = "FABRİKA" Then
        .CenterHeader = "&""-,Kalın""&24FABRİKA PERSONEL LİSTESİ" & Chr(10) & ""
     End If
    End With
End Sub

 

[iplikci_80]

Hamit Bey merhabalar, öncelikle ilginize çok teşekkür ederim. Fakat kodlarda hata mesajı veriyor. Bir kontrol etmeniz mümkün mü acaba.

 

[hamitcan]

Kodu düzelttim, bir daha deneyin.

 

[iplikci_80]

Hamit bey her şey için çok teşekkür ederim.