5 farklı listeden kalan öğrencileri başka bir sayfaya otomatik yazdurma

[teron]

Merhaba arkadaşlar. Benim sorunum şu:
5 farklı sınıfta dersten öğrencilerin başka bir sayfa otomatik olarak listelenmesi için uğraştım ama yapamadım. Bana yardımcı olursanız sevinirim.

 

[PLİNT]

Merhaba
Bir küçük örnek dosya ekleyip indirme adresi verirseniz:http://s6.dosya.tc/

 

[teron]

http://s6.dosya.tc/server6/9oi6o0/Not_Programi.xlsx.html
örnek dosya burda, şimdiden teşekkür ederim

 

[teron]

Merhaba
Bir küçük örnek dosya ekleyip indirme adresi verirseniz:http://s6.dosya.tc/

http://s6.dosya.tc/server6/9oi6o0/Not_Programi.xlsx.html örnek dosya burda, şimdiden teşekkür ederim

 

[PLİNT]

Ek dosyayı denermisiniz;
http://s6.dosya.tc/server6/cpjbim/Not_Programi.zip.html

 

[teron]

ek dosyayı denermisiniz;
http://s6.dosya.tc/server6/cpjbim/not_programi.zip.html

harikasınız, ellerinize sağlık.
BAŞKA BİR DOSYA GÖNDERSEM AYNI ŞEKİLDE TEKRAR YAPABİLİRMİSİNİZ

 

[teron]

http://s6.dosya.tc/server6/od7ad3/UM_SINIF_NOTLARI-2015-2016-1._ve_2.Donem.xlsx.html

 

[PLİNT]

Merhaba
Ek dosyayı deneyiniz.
http://s6.dosya.tc/server6/n5mdtf/UM_SINIF_NOTLARI-2015-2016-1._ve_2.Donem.zip.html

Sub geçmez()
x = 4
Set k = Sheets("Yıl Sonu Kalan Öğrenciler")
For a = 1 To Sheets.Count
If Right(UCase(Trim(Sheets(a).Name)), 7) = UCase("2.dönem") Then
Set s1 = Sheets(a)
i = s1.Cells(Rows.Count, "P").End(3).Row
For Each b In s1.Range("P7:P" & i)
With Sheets(a)
If .Cells(b.Row, "O").Value = "GEÇMEZ" Then
x = x + 1
k.Cells(x, "B") = Split(.Name, " ")(0)
k.Cells(x, "C") = .Cells(b.Row, "B").Value
k.Cells(x, "D") = .Cells(b.Row, "c").Value
k.Cells(x, "E") = .Cells(b.Row, "N").Value
k.Cells(x, "F") = .Cells(b.Row, "O").Value
End If
End With
Next:
End If
Next
End Sub

 

[teron]

Merhaba
Ek dosyayı deneyiniz.
http://s6.dosya.tc/server6/n5mdtf/UM_SINIF_NOTLARI-2015-2016-1._ve_2.Donem.zip.html

Sub geçmez()
x = 4
Set k = Sheets("Yıl Sonu Kalan Öğrenciler")
For a = 1 To Sheets.Count
If Right(UCase(Trim(Sheets(a).Name)), 7) = UCase("2.dönem") Then
Set s1 = Sheets(a)
i = s1.Cells(Rows.Count, "P").End(3).Row
For Each b In s1.Range("P7:P" & i)
With Sheets(a)
If .Cells(b.Row, "O").Value = "GEÇMEZ" Then
x = x + 1
k.Cells(x, "B") = Split(.Name, " ")(0)
k.Cells(x, "C") = .Cells(b.Row, "B").Value
k.Cells(x, "D") = .Cells(b.Row, "c").Value
k.Cells(x, "E") = .Cells(b.Row, "N").Value
k.Cells(x, "F") = .Cells(b.Row, "O").Value
End If
End With
Next:
End If
Next
End Sub

Emeğinize sağlık, çok teşekkür ederim. Ancak notları değiştirdiğimde hata veriyor.

 

[PLİNT]

Ancak notları değiştirdiğimde hata veriyor.

Kodlar "... 2.Dönem" sayfalarının "P" sütunun son satırına kadar:
"O" sütununda "GEÇMEZ" kelimesini arıyor varsa satırındakileri aktarıyor
verdiği hatayı açıklarmısınız? (Sayfa koruma şifresinide eklersiniz)

If .Cells(b.Row, "O").Value = "GEÇMEZ" Then

 

[teron]

Kodlar "... 2.Dönem" sayfalarının "P" sütunun son satırına kadar:
"O" sütununda "GEÇMEZ" kelimesini arıyor varsa satırındakileri aktarıyor
verdiği hatayı açıklarmısınız? (Sayfa koruma şifresinide eklersiniz)

If .Cells(b.Row, "O").Value = "GEÇMEZ" Then

tekrar teşekkür ederim, ben yanlış işlem yapmışım, yazdığınız kodda sıkıntı yok,emeğinize sağlık.

 

[teron]

Kodlar "... 2.Dönem" sayfalarının "P" sütunun son satırına kadar:
"O" sütununda "GEÇMEZ" kelimesini arıyor varsa satırındakileri aktarıyor
verdiği hatayı açıklarmısınız? (Sayfa koruma şifresinide eklersiniz)

If .Cells(b.Row, "O").Value = "GEÇMEZ" Then

İlk önce, ilginiz teşekkür ediyorum

Hata şu; şu an 22 kişi başarısız, eğer bir kişi başarılı olursa 21 tane geçemeyen kişi olması lazım, kalan düğmesine tıkladığımda yeniden kalanları listeliyor ancak önceki kalan listesinde en sonda olan kişiyi iki kere yazıyor çünkü önceki listeyi otmatik silmiyor, önceki listenin üzerine yazıyor.

 

[PLİNT]

Merhaba
"Kalan" düğmesi (8.mesajda ekli dosyada "CommandButton1") altındaki
kodlara aşağıdaki kırmızı bölümü ekleyelim.

Private Sub CommandButton1_Click()
x = 4
Set k = Sheets("Yıl Sonu Kalan Öğrenciler")
[COLOR="Red"]k.[B5:F10000] = Empty[/COLOR]
For a = 1 To Sheets.Count
If Right(UCase(Trim(Sheets(a).Name)), 7) = UCase("2.dönem") Then
'..........
'..........diğer kodlar

 

[teron]

Merhaba
"Kalan" düğmesi (8.mesajda ekli dosyada "CommandButton1") altındaki
kodlara aşağıdaki kırmızı bölümü ekleyelim.

Private Sub CommandButton1_Click()
x = 4
Set k = Sheets("Yıl Sonu Kalan Öğrenciler")
[COLOR="Red"]k.[B5:F10000] = Empty[/COLOR]
For a = 1 To Sheets.Count
If Right(UCase(Trim(Sheets(a).Name)), 7) = UCase("2.dönem") Then
'..........
'..........diğer kodlar

dediğiniz şekilde yazdım, şimdi hiçbir sorun yok. teşekkür ederim .