şartlı sıralama

[ben]

iki farklı grupta veriler var.
bu verilerin gruplarını ve sıralamalarını değiştirerek yeni bir sıralama yapmak istiyorum. örnek ekledim. forumda cevabını bulamadım.
yardımlarınızı bekliyorum.

 

[ben]

hala sıralayamadım

 

[veyselemre]

Sub aktar()
Set s1 = [Sayfa1]
Set s2 = [Sayfa2]
bson = s1.[B65536].End(3).Row

ReDim dizi(3 To bson, 0 To 1)

GoSub aktar
    
Set s1 = [Sayfa2]
Set s2 = [Sayfa3]
GoSub aktar

Exit Sub
aktar:

For x = 3 To bson
        dizi(x, 0) = s1.Cells(x, "B")
        dizi(x, 1) = s1.Cells(x, "D")
Next x

s2.Range("b3:d65536").ClearContents
For x = 3 To bson
        s2.Cells(x, "B") = dizi(x, 1)
Next x
        
For x = 3 To bson - 1
        s2.Cells(x, "D") = dizi(x + 1, 0)
Next x
        s2.Cells(bson, "D") = dizi(3, 0)
Return
End Sub

 

[ben]

Veysel Bey,

yardımınız için teşekkürler ama, sanırım sıralamada yanlışlık var.
ikinci ve üçüncü sayfaya aktarırken sıralama bozulmuş.
bir de her sayfada tek sıralama olacak. ben ilik sayfadaki üç sıralamay örnek olsun diye alt alta verdim.
yani ilk sıralama 1.sayfada, 2.sıralama 3. sayfada 4,5,.... 100 şeklinde olacak.

 

[veyselemre]

İlk sayfadaki örnek olarak yazdığınız 2. ve 3. sıralama kısımlarını silerek denediniz mi?

 

[ben]

Veysel Bey,

şimdi problemsiz ama sadece 3 tane (3 sayfaya) sıralama yapıyor.
ben her butona basışımda kaldığı yerden yeni bir sıralama yapmasını bunu da yeni bir sayfaya kaydetmesini istiyorum. mesela 100 sayfaya kadar sıralama yaptırabilmeliyim. ayrıca her seferde tek bir sıralama istiyorum.

çok şey mi istiyorum

 

[veyselemre]

Sub aktar()
ActiveSheet.Copy after:=ActiveSheet
bson = [B65536].End(3).Row

ReDim dizi(3 To bson, 0 To 1)

For x = 3 To bson
        dizi(x, 0) = Cells(x, "B")
        dizi(x, 1) = Cells(x, "D")
Next x

    Range("b3:d65536").ClearContents
For x = 3 To bson
        Cells(x, "B") = dizi(x, 1)
Next x
        
For x = 3 To bson - 1
        Cells(x, "D") = dizi(x + 1, 0)
Next x
        Cells(bson, "D") = dizi(3, 0)
End Sub

 

[ben]

Veysel Bey,

Mükemmel olmuş.
Çok teşekkür ederim, ellerinize beyninize sağlık.
İyi günler, iyi çalışmalar.