3 Şarta Bağlı Veri Aktarma

[ZorBey_]

Merhaba Hayırlı Ramazanlar İyi Çalışmalar
Sorunum Yıllar Sayfasından Kontrol Sayfasına
3 Şarta Bağlı Olarak Veri Aktarımıdır Yardımcı Olacak Arkadaşlara
Şimiden Teşekkür Ederim Sağolun Var Olun.

 

[halit3]

Merhaba Hayırlı Ramazanlar İyi Çalışmalar
Sorunum Yıllar Sayfasından Kontrol Sayfasına
3 Şarta Bağlı Olarak Veri Aktarımıdır Yardımcı Olacak Arkadaşlara
Şimiden Teşekkür Ederim Sağolun Var Olun.

Bir modülün içine bu kodu kopyalayın.

Sub aktar()
Worksheets("Kontrol").Range("E3:H65000").ClearContents
For r = 3 To Worksheets("Kontrol").Cells(Rows.Count, "B").End(3).Row
aranan1 = Sheets("Kontrol").Cells(r, "b").Value
aranan2 = Sheets("Kontrol").Cells(r, "c").Value
aranan3 = Sheets("Kontrol").Cells(r, "d").Value
For i = 5 To Worksheets("Yıllar").Cells(Rows.Count, "B").End(3).Row
bulunan1 = Sheets("Yıllar").Cells(i, "b").Value
bulunan2 = Sheets("Yıllar").Cells(i, "c").Value
bulunan3 = Sheets("Yıllar").Cells(i, "d").Value
If UCase(aranan1 & aranan2 & aranan3) = UCase(bulunan1 & bulunan2 & bulunan3) Then
Sheets("Kontrol").Cells(r, "e").Value = Sheets("Yıllar").Cells(i, "e").Value
Sheets("Kontrol").Cells(r, "f").Value = Sheets("Yıllar").Cells(i, "f").Value
Sheets("Kontrol").Cells(r, "g").Value = Sheets("Yıllar").Cells(i, "g").Value
Sheets("Kontrol").Cells(r, "h").Value = Sheets("Yıllar").Cells(i, "h").Value
Exit For
End If
Next i
Next r
MsgBox "işlem tamam"
End Sub

 

[ZorBey_]

Merhaba Halit Bey İlginize Teşekkür Ederim
Özür Dilerim
Hata Bende Daha Evvel Formülle İstediğimi Belirtmeliydim
Makro İle Değilde
Formülle Rica Ediyorum.

 

[N.Ziya Hiçdurmaz]

yanıt

Boşa gitmesin.

Sub aktar()
Sayfa1.[e3:h1000].ClearContents
son = Sayfa1.Cells(Rows.Count, "b").End(xlUp).Row
For sat = 5 To Sayfa2.Cells(Rows.Count, "b").End(xlUp).Row
Set bul = Sayfa1.Range("b2:B" & son).Find(Sayfa2.Cells(sat, "b"), , xlValues, xlWhole)
On Local Error Resume Next
If Not bul Is Nothing And LCase(Sayfa1.Cells(bul.Row, "c")) = LCase(Sayfa2.Cells(sat, "c")) And _
LCase(Sayfa1.Cells(bul.Row, "d")) = LCase(Sayfa2.Cells(sat, "d")) Then
    Sayfa1.Cells(bul.Row, "e") = Sayfa2.Cells(sat, "e").Value
    Sayfa1.Cells(bul.Row, "f") = Sayfa2.Cells(sat, "f").Value
    Sayfa1.Cells(bul.Row, "g") = Sayfa2.Cells(sat, "g").Value
    Sayfa1.Cells(bul.Row, "h") = Sayfa2.Cells(sat, "h").Value
    End If
Next
End Sub

 

[ZorBey_]

3 Şarta Bağlı Veri Aktarma.

Merhaba Dosyayı Değiştirmek Zorunda Kaldım Özür Dilerim
Bu dosyama Göre Yardımlarınızı Bekliyorum Çok Teşekkür Ederim Hayırlı Ramazanlar.

 

[ZorBey_]

Şimdi Gönderdim

 

[garanti01]

Şimdi Gönderdim

Dosyayı bir incelermisiniz

 

[ZorBey_]

garanti01 çok teşekkür ederim sağolun 6 nolu mesajımda dosyayı değiştirdiğimi söylemiştim lütfen 6 nolu mesajımdaki dosyaya bakabilirmisiniz o dosya biraz farklıda sağolun hayırlı ramazanlar.

 

[garanti01]

garanti01 çok teşekkür ederim sağolun 6 nolu mesajımda dosyayı değiştirdiğimi söylemiştim lütfen 6 nolu mesajımdaki dosyaya bakabilirmisiniz o dosya biraz farklıda sağolun hayırlı ramazanlar.

işinize yaradıysa ne mutlu, bahsettiğiniz dosyayı ben şimdi gördüm, ama o konu benim için çok karışık. Uzman yardımı almak lazım.

 

[ZorBey_]

anladım garanti01 çok teşekkür ederim sağolun.

 

[ZorBey_]

6 nolu mesajımdaki dosyaya inşallah başka arkadaş yardımcı olmaya çalışacaktır teşekkür ederim