bir sayfadan veri çekme

[aptillah]

merhabalar ben bir dershanede çalışıyorum ve hergün yoklama programı hazırlamamız gerekiyor kullandığımız programda öğretmen isimleri verilmediği çin elle yazıyorduk ben bu listerleri excel e döktüm ve elle yazmaktan kurtudum fakat tek bir sorun her hafta sınıfları güncellemem gerekiyor yaklaşık 50 sınıf var ve kopyala yapıştır yapmaktan bıktım .. benim yapmak istediğim bi sayfada dershanenin tüm öğrencileri olacak onları sınıflarına bakarak snıf sınıf sayfalara ayıracak böyle bir şey yapmamız mümkünmüdür.. çok uzattım şimdiden teşekkür ederim dosya ektedir

 

[halit3]

merhabalar ben bir dershanede çalışıyorum ve hergün yoklama programı hazırlamamız gerekiyor kullandığımız programda öğretmen isimleri verilmediği çin elle yazıyorduk ben bu listerleri excel e döktüm ve elle yazmaktan kurtudum fakat tek bir sorun her hafta sınıfları güncellemem gerekiyor yaklaşık 50 sınıf var ve kopyala yapıştır yapmaktan bıktım .. benim yapmak istediğim bi sayfada dershanenin tüm öğrencileri olacak onları sınıflarına bakarak snıf sınıf sayfalara ayıracak böyle bir şey yapmamız mümkünmüdür.. çok uzattım şimdiden teşekkür ederim dosya ektedir

Ekli dosyanızı kontrol ediniz.

Sub aktar()
Sheets("S1011").Range("A5:D54").ClearContents
Sheets("S1021").Range("A5:D54").ClearContents
sat1 = 5
sat2 = 5
For r = 2 To Worksheets("öğrenciler").Cells(Rows.Count, "A").End(3).Row
If Sheets("öğrenciler").Cells(r, "A").Value = "04S1011" Then
Sheets("S1011").Cells(sat1, "A").Value = sat1 - 4
Sheets("S1011").Cells(sat1, "B").Value = Sheets("öğrenciler").Cells(r, "B").Value
Sheets("S1011").Cells(sat1, "C").Value = Sheets("öğrenciler").Cells(r, "C").Value
Sheets("S1011").Cells(sat1, "D").Value = Sheets("öğrenciler").Cells(r, "D").Value
sat1 = sat1 + 1
End If
If Sheets("öğrenciler").Cells(r, "A").Value = "04S1021" Then
Sheets("S1021").Cells(sat2, "A").Value = sat2 - 4
Sheets("S1021").Cells(sat2, "B").Value = Sheets("öğrenciler").Cells(r, "B").Value
Sheets("S1021").Cells(sat2, "C").Value = Sheets("öğrenciler").Cells(r, "C").Value
Sheets("S1021").Cells(sat2, "D").Value = Sheets("öğrenciler").Cells(r, "D").Value
sat2 = sat2 + 1
End If
Next r
Sheets("S1011").Cells(sat1 + 6, "B").Value = "Toplam Öğrenci Sayısı….:" & sat1 - 5
Sheets("S1021").Cells(sat2 + 6, "B").Value = "Toplam Öğrenci Sayısı….:" & sat2 - 5
MsgBox "işlem tamam"
End Sub

 

[İhsan Tank]

merhabalar ben bir dershanede çalışıyorum ve hergün yoklama programı hazırlamamız gerekiyor kullandığımız programda öğretmen isimleri verilmediği çin elle yazıyorduk ben bu listerleri excel e döktüm ve elle yazmaktan kurtudum fakat tek bir sorun her hafta sınıfları güncellemem gerekiyor yaklaşık 50 sınıf var ve kopyala yapıştır yapmaktan bıktım .. benim yapmak istediğim bi sayfada dershanenin tüm öğrencileri olacak onları sınıflarına bakarak snıf sınıf sayfalara ayıracak böyle bir şey yapmamız mümkünmüdür.. çok uzattım şimdiden teşekkür ederim dosya ektedir

eki inceler misiniz
Halit Hocam Makro ile Çözmüş Bende Formül ile çözüm buldum.
B536 aralığındaki formüller dizi formülüdür.

Dizi Formülü Formül Hücreye Girildikten Sonra Enter Tuşuna Basmadan Ctrl+Shift+Enter Tuş Kombinasyonu İle Aktif Olmaktadır. Formülün Başında Ve Sonunda { } Bu İşaretler Çıkar Elle Eklediğiniz Takdirde Formül Hata Verir.

formüllerde 1000 satır baz alınmıştır.

 

[aptillah]

Ekli dosyanızı kontrol ediniz.

Sub aktar()
Sheets("S1011").Range("A5:D54").ClearContents
Sheets("S1021").Range("A5:D54").ClearContents
sat1 = 5
sat2 = 5
For r = 2 To Worksheets("öğrenciler").Cells(Rows.Count, "A").End(3).Row
If Sheets("öğrenciler").Cells(r, "A").Value = "04S1011" Then
Sheets("S1011").Cells(sat1, "A").Value = sat1 - 4
Sheets("S1011").Cells(sat1, "B").Value = Sheets("öğrenciler").Cells(r, "B").Value
Sheets("S1011").Cells(sat1, "C").Value = Sheets("öğrenciler").Cells(r, "C").Value
Sheets("S1011").Cells(sat1, "D").Value = Sheets("öğrenciler").Cells(r, "D").Value
sat1 = sat1 + 1
End If
If Sheets("öğrenciler").Cells(r, "A").Value = "04S1021" Then
Sheets("S1021").Cells(sat2, "A").Value = sat2 - 4
Sheets("S1021").Cells(sat2, "B").Value = Sheets("öğrenciler").Cells(r, "B").Value
Sheets("S1021").Cells(sat2, "C").Value = Sheets("öğrenciler").Cells(r, "C").Value
Sheets("S1021").Cells(sat2, "D").Value = Sheets("öğrenciler").Cells(r, "D").Value
sat2 = sat2 + 1
End If
Next r
Sheets("S1011").Cells(sat1 + 6, "B").Value = "Toplam Öğrenci Sayısı….:" & sat1 - 5
Sheets("S1021").Cells(sat2 + 6, "B").Value = "Toplam Öğrenci Sayısı….:" & sat2 - 5
MsgBox "işlem tamam"
End Sub

halit hocam çok teşekkür ederim istediğim buydu fakat ben bu kodu diger sınıfları nasıl ugluycam çnkü 50ye aşkın sınıf war ben size sadce 2 sınıf gnderdim örnek için nasıl uygulayacağımı anlatabilirseniz sevinirim şimdiden teşekkür ederim

 

[halit3]

Kodu bununla değiştirin

Sub aktar()
For i = 1 To ActiveWorkbook.Sheets.Count
If Sheets(i).Name <> "öğrenciler" Then
If Sheets(i).Name <> "DERSLER" Then
sat1 = 5
Sheets(Sheets(i).Name).Range("A554").ClearContents
MsgBox Sheets(i).Name
For r = 2 To Worksheets("öğrenciler").Cells(Rows.Count, "A").End(3).Row
If Sheets("öğrenciler").Cells(r, "A").Value = "04" & Sheets(i).Name Then
Sheets(Sheets(i).Name).Cells(sat1, "A").Value = sat1 - 4
Sheets(Sheets(i).Name).Cells(sat1, "B").Value = Sheets("öğrenciler").Cells(r, "B").Value
Sheets(Sheets(i).Name).Cells(sat1, "C").Value = Sheets("öğrenciler").Cells(r, "C").Value
Sheets(Sheets(i).Name).Cells(sat1, "D").Value = Sheets("öğrenciler").Cells(r, "D").Value
sat1 = sat1 + 1
End If
Next r
Sheets(Sheets(i).Name).Cells(sat1 + 6, "B").Value = "Toplam Öğrenci Sayısı….:" & sat1 - 5
End If
End If
Next
MsgBox "işlem tamam"
End Sub

 

[aptillah]

yardımlarınız için çok teşekkür ederim iyiy çalışmalar...

 

[halit3]

yardımlarınız için çok teşekkür ederim iyiy çalışmalar...

Teşekkürler iyi çalışmalar