Excel Vba Forum - Excelce.Net

SORU ve CEVAPLAR (Yazılabilir) => Microsoft Excel, Vba, Makro, Formül vb. Soruları => Çözülen Excel, Vba, Makro, Formül vb. Soruları => Konuyu başlatan: drummers - 13 Haziran 2011, 20:54:18

Başlık: Veri al makrosuna ilave ricası
Gönderen: drummers - 13 Haziran 2011, 20:54:18
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
Başlık: Ynt: Veri al makrosuna ilave ricası
Gönderen: Rami - 15 Haziran 2011, 01:40:32
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