Listeme ile sayfadan sayfaya veri kopyalama

[tekkral.cihan]

Y4 hücresindeki herhangibi bir konu seçtiğimde kazanım sayfasında bulunan D2,E2,F2,G2,H2,I2 hücresindeki veriler sayfa1,2,3,4,5,6 da bulunan F4,I4,L4,O4,S4,T4 hücrelerine kopyalansın.http://dosya.co/ghg7gl5ycwi1/boşs.rar.html

 

[PLİNT]

Merhaba
Ek dosyayı deneyiniz;
https://www.dosyaupload.com/4Vt0
Aşağıdaki kodları "BuÇalışmaKitabı" (Thisworkbook) kod sayfasına ekleyiniz;
Bütün sayfalar da ("kazanım" hariç) çalışacaktır

[SIZE="2"]Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Set s1 = ActiveSheet
Set s2 = Sheets("kazanım")
If s1.Name = s2.Name Then Exit Sub
a = s1.Cells(Rows.Count, "Y").End(3).Row
If Intersect(Target, s1.Range("Y4:Y" & a)) Is Nothing Then Exit Sub
Set r = s2.Range("C2:C" & Rows.Count).Find(Target.Value)
If Not r Is Nothing Then
e = Array("F", "I", "L", "O", "S", "T")
e2 = Array("D", "E", "F", "G", "H", "I")
For s = 0 To UBound(e)
s1.Cells(Target.Row, e(s)) = s2.Cells(r.Row, e2(s)).Value
Next
End If
End Sub [/SIZE]

 

[tekkral.cihan]

Hocam çok teşşekürler beni büyük bir yükten kurtardın.