Sayıya göre sıralama

[northcyprus]

Sayın hocalarım ekli dosyada sayıya göre sıralama yapmak istiyorum fakat değişkenlik gösterdiği için kod da birtakım sorun yaşıyorum aşşağıdaki kodda kırmızı olan T20 değişkenlik yani X ile Y arasına satır ekleyerek işlem yapıyorum A11 sabit kalıyor bazen 2 satır ekleniyor T13 olması gerekiyor bazen 10 satır ekleniyor T20 olması geekiyor değişkenlik gösterdiği için hata alıyorum T20 nin yerine X ile Y arasındaki A11 den D nin Son dolu oldugu hücrelerin seçimini yapılmasını sağlayabilirmiyiz aceba.


Dim C As Range, sat As Long

Set C = [A:A].Find("Y")
If Not C Is Nothing Then
sat = C.Row
End If


If sat = 11 Then Exit Sub
Rows("11:" & sat - 1).Select
Selection.UnMerge

ActiveWorkbook.Worksheets("sayfa1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("sayfa1").Sort.SortFields.Add Key:=Range("A11"), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("sayfa1").Sort
.SetRange Range("A11:T20")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

 

[northcyprus]

SAYIN HOCALARIM KODU HALLEDDİM
.SetRange Range("A11:T20")
YERİNE
.SetRange Range("A11" & "" & sat - 1) YAZINCA OLDU
TEŞEKÜRLER
SAYGILARIMLA

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Sirala()
    Dim XBul As Range, YBul As Range
    
    Set XBul = Range("A:A").Find("X", , , xlWhole)
    Set YBul = Range("A:A").Find("Y", , , xlWhole)
    
    If Not XBul Is Nothing And Not YBul Is Nothing Then
        Range("A" & XBul.Row + 1 & ":D" & YBul.Row - 1).Sort Range("A" & XBul.Row + 1), xlAscending
        MsgBox "Sıramala yapılmıştır.", vbInformation
    Else
        MsgBox "X-Y değerlerinden birisi bulunamadığı için işlem yapılamamıştır.", vbCritical
    End If

    Set XBul = Nothing
    Set YBul = Nothing
End Sub

 

[northcyprus]

Sayın Korhan Hocam Vermiş olduğunuz Kod daha uygun oldu teşekürler saygılarımla...