Sayfalar Arası Ara/Bilgileri Aktar/Renklendir

[gicimi]

Merhaba,

Örnek dosyam aşağıdaki linkte. Yardımcı olursanız sevinirim.

Bilgiler;

Ekteki dosyada Anaveri Sayfası sabit 5000 adet bilgiden oluşmaktadır.
Kontrol Ekranında yer alan B sütunundaki sayı anaveri de var ise ve Kod Grubu (F) Kod (G) sutunları dolu ise,
Sonuc bölümüne başlıkların bilgileri gelmeli,
Kontrol Ekranı sayfasında Kod Grubu ve Kod sütununda 0093 0016 ve 0093 0008 yer alıyorsa Anaveri sayfasındaki sayı sutununu Turuncu renk ile satırı renklenmeli
Son olarak Kontrol ekranı bölümünde yer alan bilgiler anaveri ekranın da Sayı Sütununda Sarı ya da Mavi ile renklensin .

http://s3.dosya.tc/server5/tr9hqk/Yeni_Calismama.xlsx.html

 

[Orion1]

Dosyanız ektedir.

Sub anaveri59()
Dim k As Range, sonsat1 As Long, sonsat2 As Long, i As Long
Dim s1 As Worksheet, s2 As Worksheet, sat As Long
sat = 2
Sheets("Anaveri").Select
sonsat1 = Cells(Rows.Count, "A").End(xlUp).Row
Set s1 = Sheets("Kontrol Ekranı")
Set s2 = Sheets("Sonuc")
s2.Range("A2:I" & Rows.Count).ClearContents
For i = 2 To sonsat1
    Set k = s1.Range("B2:B" & Rows.Count).Find(Cells(i, "A").Value, , xlValues, xlWhole)
    If Not k Is Nothing Then
        Range("A" & i).Interior.Color = vbYellow
        If s1.Range("F" & k.Row).Value <> "" And s1.Range("G" & k.Row).Value <> "" Then
            s2.Range("A" & sat & ":I" & sat).Value = Range("A" & i & ":I" & i).Value
            sat = sat + 1
            If s1.Range("F" & k.Row).Value = "0093" And s1.Range("G" & k.Row).Value = "0016" _
                Or s1.Range("F" & k.Row).Value = "0093" And s1.Range("G" & k.Row).Value = "0008" Then
                    Range("A" & i).Interior.ColorIndex = 45
            End If
        End If
    End If
    Set k = Nothing
Next i
Set s1 = Nothing: Set s2 = Nothing
MsgBox "İşlem Tamamlandı." & vbLf & "evrengizlen@hotmail.com"
End Sub

 

[gicimi]

Teşekkür ederim yardımınız için

 

[Orion1]

Teşekkür ederim yardımınız için

Rica ederim.
İyi çalışmalar.