[ÇÖZÜLDÜ] değişik sayfalarda bulunan birbiriyle bağlantılı bilgilerin tek sayfada birleştirilme

[enteresan]

[ÇÖZÜLDÜ] değişik sayfalarda bulunan birbiriyle bağlantılı bilgilerin tek sayfada birleştirilme

Değerli üstadlarım, aynı soruyu bir başka arkadaşın konusu içerisinde sorduğum için sanırım ilgilenen olmadı. Ayrı bir başlık altında tekrar sormak istedim.
Çalışma kitabı içerisinde birden fazla sayfa var ve her sayfadaki bilgilerin sadece A sütunu ortak. Yani her sayfada A sütunundaki bilgiler aynı sırada değil ama içeriği aynı.
Öyle bir kod yapmak istiyorum ki açılan kutuya A sütunundaki veriyi girdiğimde bu veriye ait diğer sayfadaki satırları bulsun ve yan yana eklesin istiyorum. Yani sayfa1 deki ilgili satır K sütununda bitmiş ise Sayfa2 deki ilgili satırı L sütunundan itibaren yapıştırsın o da AB sütununda bitti diyelim, Sayfa3 tekini de AC sütunundan itibaren yapıştırsın. Böyle bir kod düzenlenebilir mi. Eminim ki düzenlenebilir ama buna benim bilgim yetmez. Saygılarımla....

 

[enteresan]

Yukarıdaki soru hakkındaki açıklamam yetersiz kaldı düşüncesindeyim. Bunun için hazırladığım örnek dosyayı ekte gönderdim. Umarım ne demek istediğim anlaşılmıştır. Saygılar sunarım.

 

[Levent Menteşoğlu]

Aşağıdaki kodu deneyin.

Sub aktar()
Set s1 = Sheets("sayfa1")
Set s2 = Sheets("sayfa2")
Set s3 = Sheets("sayfa3")
For a = 1 To s1.[a65536].End(3).Row
s1.Range("a" & a & ":d" & a).Copy s3.Cells(a, "a")
say = WorksheetFunction.CountIf(s2.[a:a], s1.Cells(a, "a"))
If say = 0 Then GoTo 10
sat = WorksheetFunction.Match(s1.Cells(a, "a"), s2.[a:a], 0)
s2.Range("b" & sat & ":c" & sat).Copy s3.Cells(a, "e")
10 Next
End Sub

 

[Kemal Demir]

iyi akşamlar enteresan,

Öncelikle çözümü açıklamak istiyorum.Sayfa 1'i sayfa3 oncelikle kopyaladım.Sayfa 3 deki değerleri sayfa 2 de arayıp ılgılı değerleri yazdırdım.
bu kodu Kavramamda yardımcı olan Sevgili Levent Bey'e ayrıca teşekkur ederim.

umarım ek teki çözüm istediğiniz gibidir.

 

[Kemal Demir]

Üstad yine Fazlası ile hızlısın.Tebrik ederim.

 

[enteresan]

Sayın Leventm ve Rakkas, her ikinize de sonsuz saygı ve sevgiler sunarım. Teşekkür ederim....