Sayfalar arası hücre aktarımı hk.yardım

[mehmet karatay]

Sayfa2 C5 hücresine yazdığım rakamın Sayfa1 de bulunup (Sayfa1 e geçmeden) D16 (veya hangi rakam yazılırsa) hücresine H1 hücresinde yazılı bulunan BAKILDI ibaresinin kaydedilmesini yapmak istiyorum. Yardımcı olursanız sevinirim. İyi çalışmalar.

 

[Ferhat Pazarçevirdi]

Merhabalar

Aşağıdakileri Sayfa2 adlı sheet'in kod sayfasına kopyalayınız veya örnek dosyayı inceleyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim bul As Range
If Not Intersect(Target, [C5]) Is Nothing Then
   Set bul = Sheets("Sayfa1").Columns(1).Find(Target, , , xlWhole)
   If Not bul Is Nothing Then
      bul.Offset(0, 3) = Cells(1, "H")
   Else
      MsgBox "Kayıt No Bulunamadı", vbCritical, "UYARI"
      Target = Empty
   End If
   Target.Select
   Set bul = Nothing
End If
End Sub

 

[mehmet karatay]

Sayın fpc Uzun zamandır bu sitede buna benzer bir formül arayışı içindeydim ve bulamamıştım. Yardımcı oluduğum için çok teşekkür ederim. Bu kodları kendi evrakımda yapmaya çalışacağım. İyi çalışmalar.

 

[mehmet karatay]

Sayın fpc aynı evrak üzerinde I4 hücresine =bugün() diyerek tarih atılı. Sayfa1 deki D sütunundaki hücrelere BAKILDI - BAKILMADI kelimeleri giderken bu tarihte aynı anda sayfa1 deki F sütununa gidebilirmi. Ayrıca yaklaşık bu siteden 1 aydır böyle bir çalışma arıyorum. Yardımların için Teşekkür ederim.

 

[Ferhat Pazarçevirdi]

Kodlara sadece işaretli kısım ilave edildi. Eğer başka veriler de ilave etmek isterseniz, bu satırlardan çoğaltmanız gerekir.

Örneği inceleyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim bul As Range
If Not Intersect(Target, [C5]) Is Nothing Then
   Set bul = Sheets("Sayfa1").Columns(1).Find(Target, , , xlWhole)
   If Not bul Is Nothing Then
      bul.Offset(0, 3) = Cells(1, "H")
[COLOR=red]      bul.Offset(0, 5) = Cells(14, "I")[/COLOR]
   Else
      MsgBox "Kayıt No Bulunamadı", vbCritical, "UYARI"
      Target = Empty
   End If
   Target.Select
   Set bul = Nothing
End If
End Sub

 

[mehmet karatay]

Sayın fpc Yardımların için çok teşekkür ederim. Allah razı olsun beni büyük bir yükten kurtandın. İyi çalışmalar. Saygılar.

 

[Ferhat Pazarçevirdi]

Rica ederim. Kolay gelsin.

 

[mehmet karatay]

Sayın fpc üzürdileyerek bir konu daha sormak istiyorum. Aktarımlarda Belirlenen hücreler dolu olduğunda acaba uyarı alabilirmiyiz. (HÜCDE DOLU/ DEĞİŞTİRİLSİN Mİ?) diye. Lazım olacak birşey değil ama sadece bilgi olarak öğrenmek istedim. Çünkü göndermiş olduğun formüller benim işimi fazlasıyla gördü.

Birde Sayfa1 D Sütununa BAKILDI yazısı yazıldığı anda evrak kayıt nosu da Sayfa3 ün A sütununa gidebilirmi? Aynı şekilde BAKILMADI olanlarda Sayfa3 B sütununa (alt alta yazacak) Şimdiden teşekkür ederim bilgini bizlerle paylaştığın için.

 

[Ferhat Pazarçevirdi]

Kodlar, aşağıda gibi revize edilmeli.

Mesaj uyarısı yerinde bir karar olmuş. Ancak, Sayfa3'e kayıt konusunda aynı şeyi söyleyemeyeceğim. Çünkü veri giriş ortamı, şu an için tam olarak kontrol altında olmadığından, örneğin 5 nolu kaydı Sayfa3'te hem Bakıldı listesinde hem de Bakılmadı listesinde görebilme ihtimaliniz var. Yine de takdir sizin....

Örneği inceleyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim bul As Range
If Not Intersect(Target, [C5]) Is Nothing Then
   Set bul = Sheets("Sayfa1").Columns(1).Find(Target, , , xlWhole)
   If Not bul Is Nothing Then
      If IsEmpty(bul.Offset(0, 3)) = True Then
         bul.Offset(0, 3) = Cells(1, "H")
         bul.Offset(0, 5) = Cells(14, "I")
         If Cells(1, "H") = "BAKILDI" Then
            Sheets("Sayfa3").Cells(65536, 1).End(xlUp).Offset(1, 0) = bul
         Else
            Sheets("Sayfa3").Cells(65536, 2).End(xlUp).Offset(1, 0) = bul
         End If
      Else
         If MsgBox(Target & " adlı kayıda daha önceden bakılmış. Değiştirilsin mi?", vbYesNo, "UYARI") = vbYes Then
            bul.Offset(0, 3) = Cells(1, "H")
            bul.Offset(0, 5) = Cells(14, "I")
            If Cells(1, "H") = "BAKILDI" Then
               Sheets("Sayfa3").Cells(65536, 1).End(xlUp).Offset(1, 0) = bul
            Else
               Sheets("Sayfa3").Cells(65536, 2).End(xlUp).Offset(1, 0) = bul
            End If
         End If
      End If
   Else
      MsgBox "Kayıt No Bulunamadı", vbCritical, "UYARI"
      Target = Empty
   End If
   Target.Select
   Set bul = Nothing
End If
End Sub

 

[mehmet karatay]

Sy fpc Yardımların için teşekkür ederim. Dediğim gibi uzun zamandır bu konu üzerinde birşiyler yapmaya çalıştım ama yapamamıştım. ALLAH razı olsun. Çalışmalarında başarılar. Saygılar.

 

[mehmet karatay]

Sy fpc yapmış olduğun programı kendi evrakımda düzenledim. Sayende az zamanda çok iş yapmaya başladım. Yalnız bir konuda yine yardımına ihtiyacım oldu. C1 hücresindeki (örneğin 5sayısının) rakamın C5'e yapılacak bir bütona tıkladığında gelmesini istiyorum. Bu konuda yardımcı olursan sevinirim. Teşekkürler.

 

[mehmet karatay]

Arkadaşlar (yukarıdaki hücre aktarımı 3 de) Sayfa2 de c5 e yazdığımız sayıyı, Sayfa1 de bulup D ve F hücresine Yazılan yazıların A sutunundaki sayısınıda Sayfa 3 deki b sutununa aktarımını kendi evrakımda yaptım. Acaba Sayfa 1 e aktarılan yazıların satırında bulunan (mesela sayfa1 de Kayıt no 6 ya işlem yaptırdığımda) kayıt no 6 daki B veya C sutununa yazdığım isim ve soy isimi ayrı ayrı sayfa3 de belirleyeceğimiz bir yere kayıt yaptıkça aktarım yaptırabilirmiyiz. Yardımcı olursanız sevinirim. Teşekkürler.