Başka sheete veri aktarma

[sinanco]

Değerli arkadaşlar;
ekli TAKİP adlı dosyamdaki MONTAJ sheetindeki sarı ile işaretli hücrelerdeki sayılara (montajı yapılmış olanların adetlerine) çift tıklayınca o hücredeki sayı PLAN sheetindeki yeşil hücreleri ile aynı olan satırı bulup aynı tarihdeki satıra gitsin. Yani MONTAJ daki M6 hücresine (MUSTERİ="OSMA", TİP="A2", GOVDE="SC2", bu satırdaki işden 10.10.2009 tarihinde 1 adet montaj yapılmış) çift tıkladığımda bu hücredeki sayı PLAN sheetindeki aynı verili satırdaki hücreye (J3) gitsin yani J3 hücresi 1 olsun ve PLAN sheetindeki durumda böylece güncellenmiş olsun.
Umarım anlatabildim.
Yardımlarınız için şimdiden teşekkürler.
sinanco

 

[Orion1]

Dosyanız ektedir.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim k As Long, sut As Byte, sat As Long
If Intersect(Target, Range("M2:U" & Cells(65536, "A").End(xlUp).Row)) Is Nothing Then Exit Sub
Cancel = True
For k = 10 To 18
    If Sheets("PLAN").Cells(1, k).Value = Cells(1, Target.Column).Value Then
        sut = k
        GoTo atla1
    End If
Next k
Exit Sub
atla1:
With Sheets("Plan")
    For k = 2 To .Cells(65536, "A").End(xlUp).Row
        If .Cells(k, "A").Value = Cells(Target.Row, "A").Value And _
        .Cells(k, "B").Value = Cells(Target.Row, "B").Value And _
        .Cells(k, "C").Value = Cells(Target.Row, "D").Value Then
            .Cells(k, sut).Value = Target.Value
            Exit For
        End If
    Next k
End With

End Sub

 

[sinanco]

Değerli arkadaşım; ellerine sağlık. Uzmanlığın karşısında saygı ile eğiliyorum. Makro harika. Çok teşekkür ederim.
saygılarımla
sinanco

 

[Orion1]

Değerli arkadaşım; ellerine sağlık. Uzmanlığın karşısında saygı ile eğiliyorum. Makro harika. Çok teşekkür ederim.
saygılarımla
sinanco

Rica ederim.
Saygılar benden.

 

[sinanco]

Arkadaşlar,
makro çalıştı ama talepler bitmiyor:
bu sefer de verinin gönderildiği sheetdeki aktarıldığı hücre sarı olsun isteniyor.
değerli yardımlarınız için şimdiden teşekkürler.
sinanco

 

[Orion1]

Arkadaşlar,
makro çalıştı ama talepler bitmiyor:
bu sefer de verinin gönderildiği sheetdeki aktarıldığı hücre sarı olsun isteniyor.
değerli yardımlarınız için şimdiden teşekkürler.
sinanco

Dosya ekte.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim k As Long, sut As Byte, sat As Long
If Intersect(Target, Range("M2:U" & Cells(65536, "A").End(xlUp).Row)) Is Nothing Then Exit Sub
Cancel = True
For k = 10 To 18
    If Sheets("PLAN").Cells(1, k).Value = Cells(1, Target.Column).Value Then
        sut = k
        GoTo atla1
    End If
Next k
Exit Sub
atla1:
With Sheets("Plan")
    For k = 2 To .Cells(65536, "A").End(xlUp).Row
        If .Cells(k, "A").Value = Cells(Target.Row, "A").Value And _
        .Cells(k, "B").Value = Cells(Target.Row, "B").Value And _
        .Cells(k, "C").Value = Cells(Target.Row, "D").Value Then
            .Cells(k, sut).Value = Target.Value
            .Cells(k, sut).Interior.Color = vbYellow
            Exit For
        End If
    Next k
End With

End Sub

 

[sinanco]

Değerli arkadaşım evren gizlen,
sanırım ben sizi yanlış yönlendirdim: soruyu aslında şöyle sormalıydım;
plan ve montaj sheetlerini ayırmak ve 2 ayrı klasör yapmak zorunda kaldım. yani:
.......................
Workbooks("plan").Sheets("ana sayfa").Cells(1, k).Value = Cells(1, Target.Column).Value Then
........................vs
bu durumda sizin eklediğiniz satır (Range("A" & Target.Row & ":U" & Target.Row).Interior.Color = vbYellow) Plan ı boyayacağına montajı boyuyor.
oysa benim amacım plan klasöründe gittiği hücreyi boyaması (sarı olmamalı çünki, zaten sarı. o nedenle gittiği hücreyi örneğin yeşile boyamalı)
sanırım şimdi daha açık anlatabildim.
yanlış soru için özür dilerim.
değerli yardımlarınız için şimdiden teşekkürler.
saygılarımla
sinanco

 

[Orion1]

6 numaralı mesajdan dosyanızı indirebilirsiniz.

 

[sinanco]

Sn. Evren gizlen,
çok teşekkür ederim.
saygılarımla
sinanco

 

[Orion1]

Sn. Evren gizlen,
çok teşekkür ederim.
saygılarımla
sinanco

Rica ederim.
İyi çalışmalr.