koşullu veri aktarımı

[airborne]

sayın veyselemrenin kodlarını kendime uygulamaya çalıştım ama hata verdi. hatalar sayfa5 te açıklanmıştır. yardımcı olacak arkadaşlara şimdiden teşekkürler

 

[airborne]

sayfa1 den sayfa5 e aktarılması gereken sütunlar ekteteki dosyadadır.

 

[airborne]

sevgili dostlar ben MEB'lığına bağlı bir lisede görev yapmaktayım. ve bu konu demirb.aş kayıtları ve işlemleri için gerekli bir konu yanlışlıkla önceki versiyonu bmp uzantılı olarak göndermişim aktarılması gereken sütunlar adsız.zip dosyasında bulunmaktadır

 

[airborne]

dosyayı güncelledim

 

[veyselemre]

olustur prosedürünü aşağıdaki gibi değiştirin deneyin
[vb:1:8424c08f23]Sub olustur()

Hayir_Al = Array("b", "c", "g", "h", "f", "g", "h", "f", "g", "h", "f")
Hayir_ver = Array("a", "b", "c", "d", "e", "I", "j", "k", "u", "v", "w")
Evet_Al = Array("b", "c", "g", "h", "f", "g", "h", "f", "g", "h", "f")
Evet_ver = Array("a", "b", "c", "d", "e", "I", "j", "k", "l", "m", "n")

Set S1 = Sheets("Sayfa1")
Set s5 = Sheets("Sayfa5")
S1.Select
son_s1 = S1.[a65536].End(3).Row
satir = 4

For x = 1 To son_s1
satir = satir + 1
If satir = 29 Then satir = 41 '1. Sayfa
If satir = 65 Then satir = 77 '2.Sayfa
If satir = 101 Then satir = 113 '3.Sayfa
If satir = 137 Then satir = 149 '4.Sayfa
If satir = 173 Then satir = 185 '5.Sayfa
If satir = 209 Then satir = 221 '6.Sayfa
If satir = 245 Then satir = 257 '7.Sayfa
If satir = 281 Then satir = 293 '8.Sayfa
If satir = 317 Then satir = 329 '9.Sayfa
If satir = 353 Then satir = 365 '10.Sayfa
If satir = 389 Then satir = 401 '11.Sayfa
If satir = 425 Then satir = 437 '12.Sayfa
If satir = 461 Then satir = 473 '13.Sayfa
If satir = 497 Then satir = 509 '14.Sayfa
If satir = 533 Then satir = 545 '15.Sayfa
If satir = 569 Then satir = 581 '16.Sayfa
If satir = 605 Then satir = 617 '17.Sayfa
If satir = 641 Then satir = 653 '18.Sayfa
If satir = 677 Then satir = 689 '19.Sayfa
If satir = 713 Then satir = 725 '20. Sayfa
If satir = 749 Then satir = 761 '21.Sayfa
If satir = 785 Then satir = 797 '22.Sayfa
If satir = 821 Then satir = 833 '23.Sayfa
If satir = 857 Then satir = 869 '24.Sayfa
If satir = 893 Then satir = 905 '25.Sayfa
If satir = 929 Then satir = 941 '26.Sayfa
If satir = 965 Then satir = 977 '27.Sayfa
If satir = 1001 Then satir = 1013 '28.Sayfa
If satir = 1037 Then satir = 1049 '29.Sayfa
If satir = 1073 Then satir = 1085 '30.Sayfa
If satir = 1109 Then satir = 1121 '31.Sayfa
If satir = 1145 Then satir = 1157 '32.Sayfa
If satir = 1181 Then satir = 1193 '33.Sayfa
If satir = 1217 Then satir = 1229 '34.Sayfa
If satir = 1253 Then satir = 1265 '35.Sayfa
If satir = 1289 Then satir = 1301 '36.Sayfa
If satir = 1325 Then satir = 1337 '37.Sayfa
If satir = 1361 Then satir = 1373 '38.Sayfa
If satir = 1397 Then satir = 1409 '39.Sayfa
If satir = 1433 Then satir = 1445 '40.Sayfa
If satir = 1469 Then satir = 1481 '41.Sayfa
If satir = 1505 Then satir = 1517 '42.Sayfa
If satir = 1541 Then satir = 1553 '43.Sayfa
If satir = 1577 Then satir = 1589 '44.Sayfa
If satir > 1613 Then Exit Sub

If S1.Cells(x, "K") = "Evet" Then
For t = 0 To 10
s5.Cells(satir, Evet_ver(t)) = S1.Cells(x, Evet_Al(t))
Next t
End If

If S1.Cells(x, "K") = "Hayır" Then
For t = 0 To 10
s5.Cells(satir, Hayir_ver(t)) = S1.Cells(x, Hayir_Al(t))
Next t
End If
Next x
End Sub[/vb:1:8424c08f23]

 

[airborne]

sayın veyselemre hocam elinine sağlık. çok teşekkür ederim..