veri doğrulama makro

[igultekin2000]

iyi günler;

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A1]) Is Nothing Then Exit Sub
If Cells(Rows.Count, "A").End(3).Row > 1 Then _
    Range("B3:M100" & Cells(Rows.Count, "B").End(3).Row).ClearContents
If Target = "" Then Exit Sub
cson = Sheets("HAREKET").Cells(Rows.Count, "A").End(3).Row
If Target <> "" Then _
Sheets("HAREKET").Range("A1:M" & cson).AutoFilter Field:=2, Criteria1:="*" & Target.Value & "*"
If Sheets("HAREKET").Cells(Rows.Count, "A").End(3).Row = 1 Then GoTo 10
Sheets("HAREKET").Range("A2:M" & cson).SpecialCells(xlCellTypeVisible).Copy [B3]
10: Sheets("HAREKET").Range("A1:M" & cson).AutoFilter
End Sub

bu makro ile A1 hücresinde veri doğrulama ile firma seçerek onun hareketlerini görüyorum. buna ilave olarak A sütununda görülen firmalara çift tıklayarak onun A1 hücresine aktarıp o firmanın hareketini görmek istiyorum. Makroya nasıl bir ilave yapmak gerekiyor, teşekkürler.

 

[Ömer]

Merhaba,

Çalışma sayfasının kod bölümüne kopyalayınız.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim son As Long
    son = Cells(Rows.Count, "A").End(xlUp).Row
    If Intersect(Target, Range("A2:A" & son)) Is Nothing Then Exit Sub
    If Target = "" Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    [A1] = Target
End Sub

 

[igultekin2000]

Merhaba,

Çalışma sayfasının kod bölümüne kopyalayınız.
Teşekkür ederim, sorunsuz çalışıyor, iyi çalışmalar.