Seçili Hücrelere Aynı Veriyi Eklemek

[baydeniro]

Merhaba Arkadaşlar,

İçeriği farklı olan seçili hücrelere E1 hücresindeki hücreyi eklemek makro ile mümkün olur mu ?

Örnek dosya linki : http://s7.dosya.tc/server13/vmmd0m/HER_SOZCUGE_AYNI_VERIYI_EKLE.xls.html

 

[Ömer BARAN]

Merhaba.
SEÇİLİ ibaresini netleştirmeniz lazım sanırım.
C sütunundaki hücrelerden, arka plan rengi E1'inki ile aynı olanların sonuna ekleme yapılır.

Sub E1_EKLE()
For sat = 2 To Cells(Rows.Count, "C").End(3).Row
    If Cells(sat, "C").Interior.Color = [E1].Interior.Color Then _
    Cells(sat, "C") = Cells(sat, "C") & [E1]: Cells(sat, "C").Interior.Color = [C1].Interior.Color
Next
End Sub

 

[baydeniro]

Ömer Baran üstadım çok teşekkür ediyorum. Tespitinizde haklısınız. Seçil hücreler şöyle oluşacak : bir kritere göre filtrelenen verileri imleç ile seçeceğim.

 

[Ömer BARAN]

C sütununu seçmenize gerek kalmadan, filtreyi uygulayın ve makroyu çalıştırın.
Kod, C sütunundaki görünür hücrelerin sonuna E1'deki değeri ekler.

Sub E1_EKLE()
For Each hcr In Range("C2:C" & Cells(Rows.Count, _
    "C").End(3).Row).SpecialCells(xlCellTypeVisible)
    If Right(hcr.Value, Len([E1])) <> [E1] Then hcr.Value = hcr.Value & [E1]
Next
End Sub

 

[baydeniro]

Ömer Baran yine mükemmel bir kod üstadım. çok teşekkür ediyorum

 

[Ömer BARAN]

Eyvallah, geri bildirim için teşekkürler.
Kod'da "hcr.Value = hcr.Value & [E1]" kısmı da yeterli olabilirdi ancak işlem yapıldıktan sonra kod tekrar çalıştırılacak olursa,
"sonunda zaten ek var mı, yani işlem daha önce yapıldı mı?" sorusunun cevabı için "If Right(hcr.Value, Len([E1])) <> [E1] Then " kısmı eklendi.
.