Veri al makrosuna ilave ricası

[drummers]

Sub Kontrol_Listesi_Aktar()
Dim s1 As Worksheet, s2 As Worksheet
Set s1 = Sheets("data")
Set s2 = Sheets("kontrol")
s2.Range("c2:c200").Value = s1.Range("b2:b200").Value

End Sub

Üstteki makromda "data" sekmesindeki "b2:b200" aralığındaki verilerimi "kontrol" sekmeme aktarmaktayım.

İsteğim şudur: "data" sekmesindeki "b2:b200" aralığında bazı verilerimin renkleri "KIRMIZI" bu makroma eğer "b2:b200" aralığında kırmızı ile yazılmış veri varsa aktarma şartını ekliyebilirmiyiz.

Örnek dosya eklemeye gerek duymadım. Teşekkürler

[Rami]

Sub Kontrol_Listesi_Aktar()
Dim s1 As Worksheet, s2 As Worksheet
Set s1 = Sheets("data")
Set s2 = Sheets("kontrol")
s2.Range("c2:c200").Value = s1.Range("b2:b200").Value

End Sub

Üstteki makromda "data" sekmesindeki "b2:b200" aralığındaki verilerimi "kontrol" sekmeme aktarmaktayım.

İsteğim şudur: "data" sekmesindeki "b2:b200" aralığında bazı verilerimin renkleri "KIRMIZI" bu makroma eğer "b2:b200" aralığında kırmızı ile yazılmış veri varsa aktarma şartını ekliyebilirmiyiz.

Örnek dosya eklemeye gerek duymadım. Teşekkürler

Anlatımınıza göre: aşağıdaki kod işinize yarayabilir.

Kod: [Seç]


For a = 1 To Cells(65000, 1).End(xlUp).Row
If Cells(a, 2).Interior.ColorIndex <> 3 Then
b = Sheets("kontrol").Cells(65000, 3).End(xlUp).Row + 1
Sheets("kontrol").Range("c" & b).Value = Sheets("data").Range("b" & a).Value
End If
Next