İki hücredeki bilgiyi birleştirirken renk kullanılabilirmi?

[kelkitli]

Değerli Dostlar Selamlar,

Sub birleştir()
[C1] = [A1] & [B1]
End Sub

Bu kodla veri birleştiriyorum. Ancak istiyorumki A1 hücresindeki veri Siyah, B1 hücresindeki veri kırmızı olarak birleştirilsin.

 

[Ferhat Pazarçevirdi]

Birleştir adlı makronuzu aşağıdaki gibi revize ediniz.

Sub birleştir()
    [C1] = [A1] & [B1]
    With [C1]
        .Characters(1, Len([A1])).Font.ColorIndex = xlAutomatic
        .Characters(Len([A1]) + 1, Len([B1])).Font.ColorIndex = 3
    End With
End Sub

 

[kelkitli]

Sayın Ferhat Bey,
Çok teşekkür ederim. Ben bu makroyu şu şekilde uyarlamaya çalıştım yapamadım.
Sub Kaydet()
Application.ScreenUpdating = False
Set s1 = Sayfa1
Set s2 = Sayfa3
Set KRİTER = s1.Range("Q3")
s2.Select
ara = [B3:B65536].Find(What:=KRİTER, LookIn:=xlValues, Lookat:=xlWhole).Activate
ActiveCell.Offset(0, 1).Value = s1.Range("C11")
ActiveCell.Offset(0, 7).Value = s1.Range("C12") & " " & s1.Range("C13")
With ActiveCell.Offset(0, 7).Value
.Characters(1, Len(s1.Range("C12"))).Font.ColorIndex = xlAutomatic
.Characters(Len(s1.Range("C12")) + 1, Len(s1.Range("C13"))).Font.ColorIndex = 3
End With
ActiveCell.Offset(0, 12).Value = s1.Range("C15")
ActiveCell.Offset(0, 13).Value = s1.Range("C16")
ActiveCell.Offset(0, 14).Value = s1.Range("C17")
ActiveCell.Offset(0, 15).Value = s1.Range("C18")
ActiveCell.Offset(0, 16).Value = s1.Range("C19")
ActiveCell.Offset(0, 17).Value = s1.Range("C20")
ActiveCell.Offset(0, 18).Value = s1.Range("H11")
ActiveCell.Offset(0, 19).Value = s1.Range("H12")
ActiveCell.Offset(0, 20).Value = s1.Range("H14")
ActiveCell.Offset(0, 21).Value = s1.Range("H15")
ActiveCell.Offset(0, 22).Value = s1.Range("H16")
ActiveCell.Offset(0, 23).Value = s1.Range("H17")
ActiveCell.Offset(0, 24).Value = s1.Range("H18")
ActiveCell.Offset(0, 25).Value = s1.Range("H19")
ActiveCell.Offset(0, 26).Value = s1.Range("H20")
ActiveCell.Offset(0, 27).Value = s1.Range("M11")
ActiveCell.Offset(0, 28).Value = s1.Range("M12")
ActiveCell.Offset(0, 29).Value = s1.Range("M14")
ActiveCell.Offset(0, 30).Value = s1.Range("M15")
ActiveCell.Offset(0, 31).Value = s1.Range("M16")
ActiveCell.Offset(0, 32).Value = s1.Range("M17")
ActiveCell.Offset(0, 33).Value = s1.Range("M18")
ActiveCell.Offset(0, 34).Value = s1.Range("M19")
ActiveCell.Offset(0, 35).Value = s1.Range("M20")
s1.Select
Range("A2").Select
MsgBox "Kayıt İşlemi Tamamlandı."
Set s1 = Nothing
Set s2 = Nothing
Exit Sub
End Sub

Nerede hata yapıyorum.

 

[Ayhan Ercan]

Merhaba

With ActiveCell.Offset(0, 7).Value deki ".Value" kısmını silerek deneyiniz..

Aşağıdaki gibi..

[COLOR=black]With ActiveCell.Offset(0, 7)
.Characters(1, Len(s1.Range("C12"))).Font.ColorIndex = xlAutomatic
.Characters(Len(s1.Range("C12")) + 1, Len(s1.Range("C13"))).Font.ColorIndex = 3
End With[/COLOR]

 

[kelkitli]

Sayın Ayhan Ercan, Teşekkür ederim. Sorun halloldu. Sağol varol.