İkinci sayfaya nasıl aktarma yapabilirim.

[Mdemir63]

Selamlar,

Arkadaşlar benim bir listem var ve bu liste 200 kişilik bir sınıf elimdeki kodlarla birinci sayfa için 100 kişiyi listeleyebiliyorum. Ama ikinci sayfa için yapamıyorum. Ekteki dosyama bakabilirmisiniz. Zaten dosyada da anlatmak istediğimi yazdım.Şimdiden çok teşekkürler

Saygılar

 

[Mdemir63]

Selamlar,

Arkadaşlar soruyu yanlış anlatmış olabilirim ama dosyada ne yapmak istediğimi belirttim. Aşağıdaki koda 53 yerine 103 yazdığımda istediğim oluyor ancak tek sayfaya sığmadığı için bunu değiştirmek istiyorum. Dosyamda verdiğim kodlar sınıf oluştur dediğimde sınıf listesi oluşturuyor ama ;
1 4
2 5
3 6
7 11
8 12
9 13
10 14

gibi yaptırmak istiyorum.

Saygılar


If B = 53 Then: C = 9: B = 3

 

[Mdemir63]

Selamlar
Arkadaşlar yeni bir dosya ekledim. İstediğim şekli dosya içinde belirtmeye çalıştım. Bakabilrseniz çok memnun olurum.
1- A sınıfı Sayfasına normal aktarıyorum hiçbir problem yok ama yapmak istediğim ;
2- Olması istenilen A sınıfı sayfası gibi olsun istiyorum. sınıf listelerindeki sıra nolara bakılırsa yapmak istediğim daha net anlaşılabilir.


Saygılar

 

[Mdemir63]

Selamlar,

Arkadaşlar son gönderdiğim dosyama bakma şansınız var mı?

Saygılar

 

[entropy_tr]

Sayın komutan63,
aşağıdaki kodu kullanınız

Sub ASINIFI()
Dim B
Sheets("ASINIFI").Select
Range("A3:J37").ClearContents
B = 2
C = 4
For Each secim In Worksheets("VERİ").Range("S:S")
    If secim = "A" Then
    B = B + 1
    x = x + 1
    Select Case x
        Case 26
            C = 9: B = 3
        Case 51
            C = 4: B = 28
       Case 76
            C = 9: B = 28
    End Select
    
    Worksheets("ASINIFI").Cells(B, C) = secim.Offset(0, -17)
    Worksheets("ASINIFI").Cells(B, C - 2) = secim.Offset(0, -16)
    Worksheets("ASINIFI").Cells(B, C - 1) = secim.Offset(0, -9)
    Worksheets("ASINIFI").Cells(B, C - 3) = x
    End If
Next secim
MsgBox "A sınıfı oluşturuldu"
End Sub

 

[Recep İpek]

Ekli dosyanızı inceleyiniz.

Sub SınıfOluştur()
Set s1 = Sheets("VERİ")
Set s2 = Sheets("A SINIFI")
s2.Range("b3:d52").ClearContents
s2.Range("f3:h52").ClearContents
'***************************
sat = 2
For Each secim In s1.Range("b3:b27")
sat = sat + 1
sat1 = secim.Row
s2.Cells(sat, "b").Value = s1.Cells(sat1, "c").Value
s2.Cells(sat, "c").Value = s1.Cells(sat1, "j").Value
s2.Cells(sat, "d").Value = s1.Cells(sat1, "b").Value
Next
'***************************
sat = 2
For Each secim In s1.Range("b27:b51")
sat = sat + 1
sat1 = secim.Row
s2.Cells(sat, "f").Value = s1.Cells(sat1, "c").Value
s2.Cells(sat, "g").Value = s1.Cells(sat1, "j").Value
s2.Cells(sat, "h").Value = s1.Cells(sat1, "b").Value
Next
'***************************
sat = 27
For Each secim In s1.Range("b52:b76")
sat = sat + 1
sat1 = secim.Row
s2.Cells(sat, "b").Value = s1.Cells(sat1, "c").Value
s2.Cells(sat, "c").Value = s1.Cells(sat1, "j").Value
s2.Cells(sat, "d").Value = s1.Cells(sat1, "b").Value
Next
'***************************
sat = 27
For Each secim In s1.Range("b77:b101")
sat = sat + 1
sat1 = secim.Row
s2.Cells(sat, "f").Value = s1.Cells(sat1, "c").Value
s2.Cells(sat, "g").Value = s1.Cells(sat1, "j").Value
s2.Cells(sat, "h").Value = s1.Cells(sat1, "b").Value
Next
MsgBox "Bitti"
Set s1 = Nothing
Set s2 = Nothing
End Sub

 

[Mdemir63]

Selamlar,

Arkadaşlar

Çok teşekkür ederim. İyi geceler

Saygılar