Koşullu atama yapmak

[serkanım]

Merhaba

Renkli hücreleri tarayarak koşullu atama yapmak istiyorum.ekteki dosyaya ayrıntılı bilgi girdim.
Uzun süreden beri bu konu ile uğraşıyorum.Bu konuda bana yardımcı olabilirmisiniz.
Şimdiden teşekkür ediyorum.

 

[excel03]

merhaba;
ekli dosyayı incelemeniz ricasıyla.

 

[Ömer]

Merhaba,

Alternatif olsun.

Eğer renk koşulu olmayacaksa yeşil işaretli satırları silersiniz..

Sub BulKes()
 
Dim bul As Range, i As Long, sat As Long
Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet
 
Set S1 = Sheets("sayfa 1")
Set S2 = Sheets("Sayfa2")
Set S3 = Sheets("Sayfa3")
 
Application.ScreenUpdating = False
S3.Range("A2:F65536").Clear
 
sat = 1
For i = S2.Cells(Rows.Count, "A").End(3).Row To 2 Step -1
    [COLOR=green]If S2.Range("A" & i).Interior.ColorIndex <> xlNone Then[/COLOR]
        Set bul = S1.Range("A:A").Find(S2.Cells(i, "A"), _
        LookIn:=xlValues, LookAt:=xlWhole)
        If bul Is Nothing Then
            sat = sat + 1
            S2.Range("A" & i & ":F" & i).Copy S3.Cells(sat, "A")
            S2.Rows(i).Delete
        [COLOR=black]End If[/COLOR]
    [COLOR=teal]End If[/COLOR]
Next i
 
Application.ScreenUpdating = True
End Sub

.

 

[serkanım]

Teşekkürler

Merhaba Ömer Bey

Kısa sürede dönüş yaptığınız için ve vermiş olduğunuz destekten dolayı teşekkür ederim.

Dosya üzerinde bazı değişikler yaparak çalışmama devam ediyorum çok güzel bir çaılşma olacağını umuyorum.

Tekrar teşekkürler.