Soru Karışık listeyi sıralama

[NADİR YILDIZ]

kırmızı renkli olan satırları sıralı liste sayfasına alt alta boşluklar olmadan nasıl aktarım yapabilirim

 

[ÖmerFaruk]

Bu işi sürekli mi yapmanız gerekiyor?
Sürekli böyle bir problemle karşı karşıysanız GELEN LİSTE sayfanızın formatı hep böyle mi?

 

[NADİR YILDIZ]

evet sürekli olacak
gelen liste formatı aynı olacak
listesi çok uzun olanlar var 2000-3000 satır belki fazlası

iyi çalışmalar

 

[NADİR YILDIZ]

soruma çözüm buldum.
belki birinin işine yarayabilir düşüncesi ile buraya bırakıyorum

iyi çalışmalar

 

[ÖmerFaruk]

Bende bir kod yazmıştım. Deneyebilirsiniz.

Sub SıralıListeYap()
Dim Sh1 As Worksheet
Dim Sh2 As Worksheet
Dim Alan As Range

    Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
    On Error Resume Next
    Zaman = Timer
    Set Sh1 = Worksheets("GELEN LİSTE")
    Set Sh2 = Worksheets("SIRALI LİSTE")
    If Sh2.UsedRange.Rows.Count > 8 Then Sh2.Range("U9:AH" & Sh2.UsedRange.Rows.Count).ClearContents
    Sh1.AutoFilterMode = False
    Sh1.ShowAllData
    Set Alan = Sh1.Range("A1:O" & Sh1.UsedRange.Rows.Count)
    
    Alan.UnMerge
    Alan.AutoFilter Field:=2, Criteria1:=RGB(255, 0, 0), Operator:=xlFilterFontColor
    Alan.SpecialCells(xlCellTypeVisible).Copy
    Sh2.Range("T9").PasteSpecial (xlPasteValues)
    Sh2.Rows(9).Delete
    Sh2.Range("U9").Select
    Sh1.AutoFilterMode = False
    Sh1.ShowAllData
    Alan = Nothing
    Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
    MsgBox "Gelen Liste Sıralı olarak düzenlendi ..." & vbNewLine & _
    "İşlem Süresi: " & Format(Timer - Zaman, "0.00") & " sn.", vbInformation, "İŞLEM TAMAM"
End Sub

 

[NADİR YILDIZ]

Sayın nextlevel teşekkür ederim.

iyi çalışmalar