Yeşil Satırları Kopyalamak

[SER973]

Satırlarda en az bir hücrenin dolgu rengi YEŞİL olması halinde o satırı kopyalayıp.Diğer sayfada listelemesini makro ile sağlamak mümükün müdür..? Örnek Dosya Ektedir..

Yardımlarınızı ve çözüm önerilerinizi bekliyorum...

 

[Tarkan VURAL]

yanıt

Sub yesilseckopyala()
Dim syf1 As Worksheet, syf2 As Worksheet, bak As Variant, i As Long
Set syf1 = Sheets("data"): Set syf2 = Sheets("list")
Set bak = syf1.Range("a2:f" & syf1.Range("f65536").End(3).Row)
For Each bul In bak
If bul.Interior.ColorIndex = 4 Then
adres = Mid(bul.Address, InStrRev(bul.Address, "$", -1, 1) + 1, 5)
Cells(adres, "h") = 1
End If
Next
For i = 2 To syf1.Range("a65536").End(3).Row
If Cells(i, "h").Value = 1 Then
syf1.Rows(i).Copy Destination:=syf2.Range("a65536").End(3)(2, 1)
End If
Next i
syf1.Columns("h").ClearContents: syf2.Columns("h").ClearContents
Set syf1 = Nothing: Set syf2 = Nothing: Set bak = Nothing
adres = Empty: i = Empty
End Sub

 

[SER973]

Çok Teşekkürler

Sn. Tarkan VURAL yardımlarınız için çok teşekkür ederim. Tam İstediğim Gibi olmuş...

 

[Tarkan VURAL]

Tam İstediğim Gibi olmuş...

Rica ederim, afiyet olsun