Başka bir kitaptaki verileri çağırma

[gencoglu27]

Merhaba arkadaşlar,
Bir kitapta iken diğer kitaplardaki veriyi çağırmak istiyorum.
Şöyleki;
Kitap1 deki sayfa1 de 23 öğrenciye ait matematik
sayfa2 de fen notları ,sayfa 3 te sosyal notları var
Aynı şekilde ,Kitap2 deki sayfa1 de resim,sayfa2 de müzik
ve sayfa 3 te ingilizce notları var.
Amacım kitap3 te A1 hücresine yazacağım isme ait 6 dersin notları
d1,d2,d3,d4,d5,d6 ya yazılsın.

Yardımlarınız için önceden teşekkür ediyorum..

 

[İhsan Tank]

Merhaba
Hangi sıraya göre alınacak önce Kitap1'dekiler mi alınacak Kitap2'deki mi_?

 

[gencoglu27]

Merhaba
Hangi sıraya göre alınacak önce Kitap1'dekiler mi alınacak Kitap2'deki mi_?

Evet önce Kitap1 dekiler,sonra kitap2 ler.

 

[İhsan Tank]

Evet önce Kitap1 dekiler,sonra kitap2 ler.

Kitap3'e bir kaçtane veri girer misiniz_? Ayrıca bu verileri nereden aldığınızıda işaretleyin ki anlayıp kodu yazalım

 

[gencoglu27]

Kitap3'e bir kaçtane veri girer misiniz_? Ayrıca bu verileri nereden aldığınızıda işaretleyin ki anlayıp kodu yazalım

İstediğiniz gibi Kitap3 e 1.kişiye ait verileri manuel olarak girdim..

 

[İhsan Tank]

İstediğiniz gibi Kitap3 e 1.kişiye ait verileri manuel olarak girdim..

Alltaki sekmeleri gözden kaçırmışım.
Kodu yazıyorum umarım başarılı olurum

 

[gencoglu27]

Kitap1 ,kitap2 ve kitap3 aynı klasör içinde farz edip ilgili sayfadaki ilgili kişiye "link" vermek mümkün değil mi ? Biz şimdilik sadece kitap1 den Ali gençin notlarını çağıralım..Matematik,fen sosyal..
Kitap2 çalışma sayfasını başka bir hücrede deneriz..

 

[İhsan Tank]

Kitap1 ,kitap2 ve kitap3 aynı klasör içinde farz edip ilgili sayfadaki ilgili kişiye "link" vermek mümkün değil mi ? Biz şimdilik sadece kitap1 den Ali gençin notlarını çağıralım..Matematik,fen sosyal..
Kitap2 çalışma sayfasını başka bir hücrede deneriz..

Merhaba
Sayfanın kod bölümüne kopyalayın ve deneyin.
A1 hücresindeki değişikliğe göre kod çalışacaktır.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
Dim ts, kaplan, trabzonspor, hamsi As Date
Dim bordo, mavi, kral, asi
trabzonspor = MsgBox(UCase(Replace(Replace(Range("A1"), "ı", "I"), "i", "İ")) & vbLf _
& "Bilgilerini Alıyorum", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
Application.ScreenUpdating = False
hamsi = Time
bordo = ActiveWorkbook.Name
mavi = ActiveSheet.Name
kral = ThisWorkbook.Path & "\"
asi = "Kitap1.xlsx"
Workbooks(bordo).Sheets(mavi).Range("D:I").ClearContents
Workbooks.Open (kral & asi)
trabzonspor = 1
For kaplan = 1 To Workbooks(asi).Sheets.Count
For ts = 1 To Workbooks(asi).Sheets(kaplan).Cells _
(Rows.Count, "A").End(xlUp).Row
If UCase(Replace(Replace(Workbooks(asi).Sheets(kaplan).Cells(ts, "A") & " " & _
Workbooks(asi).Sheets(kaplan).Cells(ts, "B"), "ı", "I"), "i", "İ")) = UCase(Replace( _
Replace(Workbooks(bordo).Sheets(mavi).Range("A1"), "ı", "I"), "i", "İ")) Then
Workbooks(asi).Sheets(kaplan).Range("C" & ts & ":H" & ts).Copy _
Destination:=Workbooks(bordo).Sheets(mavi).Range("D" & trabzonspor)
trabzonspor = trabzonspor + 1
End If
Next
Next
Workbooks(asi).Close
asi = "Kitap2.xlsx"
Workbooks.Open (kral & asi)
For kaplan = 1 To Workbooks(asi).Sheets.Count
For ts = 1 To Workbooks(asi).Sheets(kaplan).Cells _
(Rows.Count, "A").End(xlUp).Row
If UCase(Replace(Replace(Workbooks(asi).Sheets(kaplan).Cells(ts, "A") & " " & _
Workbooks(asi).Sheets(kaplan).Cells(ts, "B"), "ı", "I"), "i", "İ")) = UCase(Replace( _
Replace(Workbooks(bordo).Sheets(mavi).Range("A1"), "ı", "I"), "i", "İ")) Then
Workbooks(asi).Sheets(kaplan).Range("C" & ts & ":H" & ts).Copy _
Destination:=Workbooks(bordo).Sheets(mavi).Range("D" & trabzonspor)
trabzonspor = trabzonspor + 1
End If
Next
Next
Workbooks(asi).Close
Application.ScreenUpdating = True
MsgBox Format(hamsi - Time, "hh:mm:ss") & vbLf _
& "Sürede " & UCase(Replace(Replace(Range("A1"), "ı", "I"), "i", "İ")) & vbLf _
& "Verilerini Aldım", , "Bitiş"
End Sub

 

[gencoglu27]

Hocam eline aklına sağlık.. sihirbaz gibisiniz.. çok teşekkür ediyorum..saygılarımla..

 

[İhsan Tank]

Hocam eline aklına sağlık.. sihirbaz gibisiniz.. çok teşekkür ediyorum..saygılarımla..

Rica ederim
İlginç bir benzetme olmuş
Sitedeki tüm arkadaşlar öyledir.
:keyif: