renkli satır ayıklama

[EGZELL]

arkadaşlar ekte gönderdiğim tablodaki renkli satırları rengine göre ayıklayıp
2.sayfaya atacak bir formül arıyorum.yardımcı olacak arkadaşlara şimdiden teşekkür ederim.

 

[Orion1]

Formülle değilde makro ile
Butona tıklayınız.Ekli dosyayı inceleyiniz.

 

[EGZELL]

yardımlarınız için çok teşekkür ederim evren bey!! yanlız bunu nasıl yaptığınızı da söylerseniz çok mutlu olurum, çünkü vereceğiniz yöntemi ben çok büyük bir tabloda uygulayacağım.

 

[Orion1]

Renk kodlarını sayfa2'de C sütununa yazdırıyorum.Sonra C sütununa göre artan sıralama yapıyorum.
Sonrada C sütunundaki kolunu siliyorum.
Burada dikkat edeceğiniz nokta C sütununa hiçbir şekilde veri girmemeniz gerkiyor.Zira C kolunu silinecektir.
Kodlar aşağıdadır.

Sub renkli()
Dim sat As Long, i As Long
Sheets("Sayfa1").Select
Sheets("Sayfa2").Range("A2:B65536").Clear
sat = 2
Application.ScreenUpdating = False
For i = 2 To Cells(65536, "B").End(xlUp).Row
    If Cells(i, "B").Interior.ColorIndex <> xlNone Then
        Sheets("Sayfa2").Cells(sat, "A").Value = Cells(i, "A").Value
        Sheets("Sayfa2").Cells(sat, "B").Value = Cells(i, "B").Value
        Sheets("Sayfa2").Range("A" & sat & ":B" & sat).Interior.ColorIndex = Cells(i, "B").Interior.ColorIndex
        Sheets("Sayfa2").Cells(sat, "C").Value = Cells(i, "B").Interior.ColorIndex
        sat = sat + 1
    End If
Next i
Sheets("Sayfa2").Select
Range("A2:C65536").Sort Range("C2")
Columns(3).Delete
MsgBox "&#304;&#351;lem Tamam....!!", vbOKOnly + vbInformation, "&#304;&#350;LEM"
End Sub

 

[Orion1]

Sheets("Sayfa2").Range("A2:B65536").Clear

Kodlardaki yukarıdaki satırı aşağıdaki satır ile değiştiriniz.

Sheets("Sayfa2").Range("A2:[COLOR="Red"][B]C[/B][/COLOR]65536").Clear

 

[musculus]

ekteki dosyayı inceleyiniz