Hücre rengine göre başka hücreye yazdırma

[H3V3S]

Arkadaşlar Bi konu hakkında yardımınıza ihtiyacım var şimdiden teşekkür ederim.

B3:B38 hücrelerinde isimler var. Ben bu hücrede bulunan isimlerin, hücre dolgusu sarı olanları bir buton ile yani butona bastığım zaman J3:J12 hücrelerine yazdırmak istiyorum,

Not: sarı renkli hücreler en az 1 tane en fazla 10 tane oluyo, sürekli sarı renkli hücre sayılarında değişiklik oluyor. Kaç tane olursa olsun J3:J12 hücrelerine yazdırması gerekiyor

 

[muratboz06]

Deneyiniz.

Sub test()
    j = 3
    For i = 3 To 38
        If Cells(i, 2).DisplayFormat.Interior.Color = 65535 Then
            Cells(j, 10) = Cells(i, 2)
            'Cells(j, 10).Interior.Color = 65535 'j sütunundaki dolu hücreleri sarı renkli yapmak isterseniz bu satırın başındaki ' işaretini kaldırınız.
            j = j + 1
        End If
    Next i
End Sub

 

[H3V3S]

Hocam çok teşekkür ederim istediğim gibi çalıştı kod. Yalnız başka renk için yapacak olsam renk kodlarını nerden bulabilirim

 

[muratboz06]

A1 hücresinin dolgu rengini msgbox olarak gösterir.

Sub DolguRengi()
MsgBox Range("A1").DisplayFormat.Interior.Color
End Sub

 

[H3V3S]

Hocam kusura bakmayın vaktinizi alıyorum, yukarıda bahsettiğim konuyu bu şekilde düzeltip tekrar Kodu güncelleyebilirmisiniz ben denemeye çalıştım yapamadım. Yardımcı olursanız sevinirim

B3:C38 hücrelerinde isimler var. Ben bu hücrede bulunan isimlerin, hücre dolgusu sarı olanları bir buton ile yani butona bastığım zaman I3:J12 hücrelerine yazdırmak istiyorum

 

[muratboz06]

B sütunundakileri I sütununa C sütunundakiler J sütununa mı gelecek?

 

[H3V3S]

Doğru hocam ama ben yanlış yazmışım sütun isimlerini, B sütünundakiler J sütünuna, C sütunundakiler de K sütununa gelecek

 

[muratboz06]

Deneyiniz.

Sub test()
For a = 2 To 3
    j = 3
    For i = 3 To 38
        If Cells(i, a).DisplayFormat.Interior.Color = 65535 Then
            Cells(j, a + 8) = Cells(i, a)
            'Cells(j, a + 8).Interior.Color = 65535  'j-k sütunundaki dolu hücreleri sarı renkli yapmak isterseniz bu satırın başındaki ' işaretini kaldırınız.
            j = j + 1
        End If
    Next i
Next a
End Sub

 

[H3V3S]

Hocam çok teşekkür ederim elinize emeğinize sağlık