verilerin diğer sayfalara dağıtılması

[osmandemir]

kolay gelsin konu da bulan verilerin diğer sayfalara aktarabilirimiyiz örneğin E sutundaki işaretli olan no ad soyad ların E6 daki sayfaya belitlen yere yazdırabilirmiyiz

 

[muygun]

Merhaba;
Amaç sadece yoklama listesi oluşturmaksa (bu sayfalardan sadece çıktı alınacaksa) osmandemir-program-1 uygulamasını deneyin.
İyi çalışmalar.

 

[halit3]

kolay gelsin konu da bulan verilerin diğer sayfalara aktarabilirimiyiz örneğin E sutundaki işaretli olan no ad soyad ların E6 daki sayfaya belitlen yere yazdırabilirmiyiz

Alternatif olarak
Bu kodu denermisiniz.

Sub aktar2()
For i = 5 To Worksheets(ActiveSheet.Name).Cells(6, Columns.Count).End(xlToLeft).Column
For n = 7 To Worksheets("KONU").Cells(65000, i).End(3).Row
Sayfaadi = Worksheets("KONU").Cells(6, i).Value
Sonsatır = Worksheets(Sayfaadi).Cells(65000, 1).End(3).Row + 1
If Worksheets("KONU").Cells(n, i).Value <> "" Then
Worksheets(Sayfaadi).Cells(Sonsatır, 1).Value = Sonsatır - 3
Worksheets(Sayfaadi).Cells(Sonsatır, 2).Value = Worksheets("KONU").Cells(n, 1).Value
Worksheets(Sayfaadi).Cells(Sonsatır, 3).Value = Worksheets("KONU").Cells(n, 2).Value
Worksheets(Sayfaadi).Cells(Sonsatır, 4).Value = Worksheets("KONU").Cells(n, 3).Value
End If
Next n
Next i
MsgBox "işlem tamam"
End Sub

 

[osmandemir]

arkadaşlar ellerinize sağlık muygunada teşkkürediyorum halit3 yazmış olduğun kodu uyguladım eğr olursa listele yaparken yeni liste oluşturuken eskisini silse olur mu birde kanu sayfasında seans 1 de birkişi 1 tane işaretleşe seans 2de 1 tane ve seans 3 te birtane işretleyebilsin mümkün olurmu

 

[halit3]

arkadaşlar ellerinize sağlık muygunada teşkkürediyorum halit3 yazmış olduğun kodu uyguladım eğr olursa listele yaparken yeni liste oluşturuken eskisini silse olur mu birde kanu sayfasında seans 1 de birkişi 1 tane işaretleşe seans 2de 1 tane ve seans 3 te birtane işretleyebilsin mümkün olurmu

Silme işi tamam

Sub aktar2()
For i = 5 To Worksheets(ActiveSheet.Name).Cells(6, Columns.Count).End(xlToLeft).Column
Sayfaadi = Worksheets("KONU").Cells(6, i).Value
Worksheets(Sayfaadi).Range("A4:E65000").ClearContents
For n = 7 To Worksheets("KONU").Cells(65000, i).End(3).Row
Sonsatır = Worksheets(Sayfaadi).Cells(65000, 1).End(3).Row + 1
If Worksheets("KONU").Cells(n, i).Value <> "" Then
Worksheets(Sayfaadi).Cells(Sonsatır, 1).Value = Sonsatır - 3
Worksheets(Sayfaadi).Cells(Sonsatır, 2).Value = Worksheets("KONU").Cells(n, 1).Value
Worksheets(Sayfaadi).Cells(Sonsatır, 3).Value = Worksheets("KONU").Cells(n, 2).Value
Worksheets(Sayfaadi).Cells(Sonsatır, 4).Value = Worksheets("KONU").Cells(n, 3).Value
End If
Next n
Next i
MsgBox "işlem tamam"
End Sub

 

[osmandemir]

yardımlarınız için teşekkür ediyorum

 

[halit3]

yardımlarınız için teşekkür ediyorum

İyi çalışmalar