• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Bir Veriyi Başka Çalışma Kitabında Arama

Katılım
10 Ocak 2013
Mesajlar
97
Excel Vers. ve Dili
2013 versiyon
Arkadaşlar Merhaba..Benim çalıştıramadığım bir makro var.. A çalışma kitabının bir hücresindeki veriyi kopyalayıp, B çalışma kitabının 1.sayfasında aratmak istiyorum..

Yardımcı olursanız sevinirim..teşekkürler şimdiden
 
Merhaba
Bu tarz sorularınız için örnek dosya eklerseniz daha rahat yardımcı olabiliriz diye düşünüyorum.
 
Merhaba
Bu tarz sorularınız için örnek dosya eklerseniz daha rahat yardımcı olabiliriz diye düşünüyorum.

Tabi ki dosyayı ekleyeyim mesajı yeniden yazayım :

A çalışma kitabının örneğin A2 hücresindeki veriyi bir tıklama ile -buton ilede olabilir- aratıp B çalışma kitabında bu veriyi bulmasını istiyorum..

yardımcı olursanız çok sevinirim...
 

Ekli dosyalar

  • A.xls
    A.xls
    13.5 KB · Görüntüleme: 6
  • B.xls
    B.xls
    14.5 KB · Görüntüleme: 4
Dosyanız ektedir.
A sütununa çift tıklama ile çalışıyor.
A sütunjunda tıkladınız yerde mutlaka veri olmalıdır.:cool:
Kod:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim k As Range, sat As Long
If Intersect(Target, Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)) Is Nothing Then Exit Sub
If Workbooks.Open(ThisWorkbook.Path & "\B.xls").ReadOnly = True Then Workbooks("B.xls").Close False
sat = Workbooks("B.xls").Sheets("Sayfa1").Cells(Rows.Count, "A").End(xlUp).Row
ThisWorkbook.Activate
Set k = Workbooks("B.xls").Sheets("Sayfa1").Range("A2:A" & sat).Find(Target.Value, , xlValues, xlWhole)
If Not k Is Nothing Then
    Target.Offset(0, 1).Value = k.Offset(0, 1).Value
    Target.Offset(0, 2).Value = k.Offset(0, 2).Value
    Else
    MsgBox "Tıklanan veri bulunamadı"
End If
Workbooks("B.xls").Close False
Cancel = True
 

Ekli dosyalar

Dosyanız ektedir.
A sütununa çift tıklama ile çalışıyor.
A sütunjunda tıkladınız yerde mutlaka veri olmalıdır.:cool:
Kod:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim k As Range, sat As Long
If Intersect(Target, Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)) Is Nothing Then Exit Sub
If Workbooks.Open(ThisWorkbook.Path & "\B.xls").ReadOnly = True Then Workbooks("B.xls").Close False
sat = Workbooks("B.xls").Sheets("Sayfa1").Cells(Rows.Count, "A").End(xlUp).Row
ThisWorkbook.Activate
Set k = Workbooks("B.xls").Sheets("Sayfa1").Range("A2:A" & sat).Find(Target.Value, , xlValues, xlWhole)
If Not k Is Nothing Then
    Target.Offset(0, 1).Value = k.Offset(0, 1).Value
    Target.Offset(0, 2).Value = k.Offset(0, 2).Value
    Else
    MsgBox "Tıklanan veri bulunamadı"
End If
Workbooks("B.xls").Close False
Cancel = True

çok teşekkür ederim kardeşim ama ben bu kodu B kitabının neresine yapıştıracağım ?
 
birde A sütununa çift tıkladığım zaman B sayfası açılmıyor yani açık olsa da ne aradığımı bulup göstermiyor..bir yerde hata mı yaptım ?
Bu kodu butona yerleştirebilir miyiz
 
Geri
Üst