Hücre içersindeki kırmızı ile yazılan yazılara göre sıralamak

[easycafe]

merhaba,

ekteki dosyamda da görüleceği üzere kırımızı ile yazılan yazılara göre sıralamak istiyorum. mümkün müdür?

teşekkür ederim.

 

[easycafe]

renge göre sıralamak. yardım eden yok mu

 

[Necdet]

Merhaba,

Dosyayı inceleyiniz.

Sub Sirala()
 
Dim SonKolon As Integer
Dim i As Long
SonKolon = [IV1].End(1).Column + 1
For i = 2 To [A65536].End(3).Row
    If Cells(i, "B").Font.ColorIndex = 3 Then Cells(i, SonKolon) = 0
Next i
Range(Cells(2, "A"), Cells([A65536].End(3).Row, SonKolon)).Sort Key1:=Cells(2, SonKolon), Key2:=[B2]
Columns(SonKolon).Delete Shift:=xlToLeft
 
End Sub

 

[easycafe]

çok teşekkür ederim.

 

[Necdet]

Merhaba,

Aşağıdaki gibi bir kod sanırım işinizi daha da kolaylaştırır. Diğer renkleri de dikkate alıp renkler arasında ayrım yapmamak gerek

Sub Sirala()
Dim SonKolon As Integer
Dim i As Long
SonKolon = [IV1].End(1).Column + 1
For i = 2 To [A65536].End(3).Row
    Cells(i, SonKolon) = Cells(i, "B").Font.ColorIndex
Next i
Range(Cells(2, "A"), Cells([A65536].End(3).Row, SonKolon)).Sort Key1:=Cells(2, SonKolon), Key2:=[B2]
Columns(SonKolon).Delete Shift:=xlToLeft
End Sub