bir sheete aldığım veriyi başka sheette karşılığında veri yazma

[u.L.a.s]

merhaba

sheet1 üzerinde A sütununda herhangi bir hücreye çift tıklayınca o hücrenin bulunduğu satırdaki verileri sheet2 ye atıyorum ve sheet1 deki o satır silinmiş oluyor.

şimdi sheet2 ye aldığım bu satırda c sütunundaki veri sheet5 te a sütunu içerisindede var. sorum şu. sheet2 deki bu verinin benzerini sheet5 te bulunca o satırda o sütunundaki hücreye "iptal edildi" bilgisini yazsın istiyorum.

bilgi ve yardımlarınızı rica ederim

sheet1 yani aktif diye isimlendirdiğim sheette çift tıklayınca Sheet2 yani iptaller sheetine o tıkladığım hücredeki satırdaki verileri gönderen makro kod aşağıda olup bu kod içerisine yukarıda istediğim durumu ekleyebiliriz. yani sheet2 ye veri gidince bir sonraki işlem sheet5 e bakarak o verinin karşılığındaki O sütunundaki hücreye iptal edildi yazabilir

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim S1 As Worksheet, S2 As Worksheet, Son As Long
    Set S1 = Sheets("Aktif")
    Set S2 = Sheets("iptaller")
    S1.Select
    If ActiveCell.Column = 1 Then
        Son = S2.Cells(S2.Rows.Count, 1).End(3).Row + 1
        S1.Range("A" & ActiveCell.Row & ":AL" & ActiveCell.Row).Copy S2.Range("B" & Son)
        S2.Range("A" & Son) = Date
        ActiveCell.EntireRow.Delete
    End If
    Set S1 = Nothing
    Set S2 = Nothing
End Sub

 

[Ömer BARAN]

Merhaba.

Kullandığınız kod'u aşağıdakiyle değiştirin.
(Eklenen kısımları kırmızı renklendirdim.)
.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim S1 As Worksheet, S2 As Worksheet[COLOR="red"], S3 As Worksheet[/COLOR], Son As Long[COLOR="Red"], sat As Integer[/COLOR]
    Set S1 = Sheets("Aktif")
    Set S2 = Sheets("iptaller")
[COLOR="red"]    Set S3 = Sheets("[B]sheet5[/B]")[/COLOR]
    S1.Select
    If ActiveCell.Column = 1 [COLOR="red"]And ActiveCell.Value <> ""[/COLOR] Then
        Son = S2.Cells(S2.Rows.Count, 1).End(3).Row + 1
        S1.Range("A" & ActiveCell.Row & ":AL" & ActiveCell.Row).Copy S2.Range("B" & Son)
        S2.Range("A" & Son) = Date
[COLOR="red"]        If WorksheetFunction.CountIf(S3.[A:A], S1.Cells(ActiveCell.Row, "C")) > 0 Then
            sat = WorksheetFunction.Match(S1.Cells(ActiveCell.Row, "C"), S3.[A:A], 0)
            S3.Cells(sat, "O") = "iptal edildi."
        End If[/COLOR]
        ActiveCell.EntireRow.Delete
    End If
[COLOR="Red"]    Cancel = True[/COLOR]
    Set S1 = Nothing
    Set S2 = Nothing
[COLOR="red"]    Set S3 = Nothing[/COLOR]
End Sub

 

[u.L.a.s]

Üstadım emeğine bilgine sağlık çok çok teşekkür ederim