İlgili hücreye tıklandığında çalışan makro

[harziyan]

Merhabalar;
Üzerinde çalıştığım bir dosyadaki problemleri çözmeye devam ediyorum.
Şu an sizden isteğimi şöyle anlatayım. "Liste" sayfasında "A" sütunundaki herhangi bir tarihi seçtiğimde aynı satırdaki değerleri aşağıdaki şekilde "tge" sayfasına aktarmak istiyorum;

• "tge" sayfasında A8:A12 hücrelerine, "Liste" sayfasındaki "X" işaretli personelleri
• "tge" sayfasında F7 hücresine "S" işaretli personeli yazdırmak istiyorum.

Teşekkürler

 

[harziyan]

Konu hâlâ güncel arkadaşlar.

 

[Ziynettin]

Merhaba,

Aşağıdaki kodu Liste sayfanızın kod alanına ekleyin. Liste sayfasında tarihler üzerine çift tıklayarak verilerinizi tge sayfasında gözlemleyiniz.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Y As Integer, Sat As Integer, Satir As Integer
Dim Tarih As Date, S1 As Worksheet
Application.ScreenUpdating = False
If Target.Column = 1 And Target.Row > 1 Then
Cancel = True
Set S1 = Sheets("tge")
    S1.Range("A8:A12") = ""
    Tarih = Target.Value
    Sat = Target.Row
    
    Satir = 8
    For Y = 7 To 23
        If Cells(Sat, Y) <> "" And Cells(Sat, Y) = "X" Then
            S1.Cells(Satir, 1) = Cells(1, Y)
            Satir = Satir + 1
        ElseIf Cells(Sat, Y) <> "" And Cells(Sat, Y) = "S" Then
            S1.Range("F7") = Cells(1, Y)
        End If
    Next Y
    S1.Range("B15") = Cells(Sat, "B")
    S1.Range("B13") = Cells(Sat, "C")
    S1.Range("F9") = Cells(Sat, "D")
    S1.Range("D19") = Cells(Sat, "E")
    S1.Range("F19") = Cells(Sat, "F")
End If
Application.ScreenUpdating = True
S1.Select
End Sub

 

[harziyan]

Sayın tasmed çok teşekkür ederim. Mükemmel.:bravo::keyif: