Hücre rengine göre ayrı sayfaya taşıma

[Bagcivan]

Arkadaşlar merhaba,

Forumda daha önce açılmış konuları inceledim. Çoğunlukla hücrelerin rengine göre listeme veya toplama işlemi için örnekler mevcut.

Fakat benim yapmak istediğim, koşula göre renklerdidiğim N sütuna göre, satırdaki bazı bilgileri sayfa2 ye listemek istiyorum.

Konuyla ilgili yardımcı olabilir misiniz?

İyi günler

 

[dEdE]

Merhaba,
Aşağıdaki kodu dener misiniz?

Sub Aktar()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
s2.Columns("F:G").NumberFormat = "d-mmm"
For i = 2 To s1.Range("N" & Rows.Count).End(3).Row
    ss = s2.Cells(Rows.Count, "A").End(3).Row + 1
    If s1.Cells(i, "N").Interior.ColorIndex = 3 Then
        s2.Cells(ss, "A").Value = s1.Cells(i, "N").Value
        s2.Cells(ss, "B").Value = s1.Cells(i, "O").Value
        s2.Cells(ss, "C").Value = s1.Cells(i, "J").Value
        s2.Cells(ss, "D").Value = s1.Cells(i, "L").Value
        s2.Cells(ss, "E").Value = s1.Cells(i, "H").Value
        s2.Cells(ss, "F").Value = s1.Cells(i, "F").Value
        s2.Cells(ss, "G").Value = s1.Cells(i, "E").Value
    End If
Next i
MsgBox "Aktarma İşlemi Tamamlandı.", vbInformation, "dEdE " & Application.UserName & "'e Başarılar diler."
End Sub