Makro ile hücreye veri girilince arka planı renklendirme

[sirkülasyon]

Selamün Aleyküm

Örneğin
H5 hücresine rakam girdiğim zaman
A5:AA5 satırı olduğu gibi arka planı "%15 Koyu Beyaz" olacak şekilde yapmak istiyorum.

Bu makro
A5 :AA150 aralığında bulunan her satır için geçerli olacak şekilde olabilmesi için Makro konusunda rica etsem yardımcı olabilir misiniz?

Teşekkür eder saygılarımı sunarım.

 

[Ömer]

Merhaba,

Sayfanın kod bölümüne kopyalayıp yapıştırın.

Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, [H5:H150]) Is Nothing Then Exit Sub
    
    If Target.Count > 1 Then Exit Sub
    With Cells(Target.Row, "A").Resize(1, 27).Interior
        .ColorIndex = xlNone
        If IsNumeric(Target) = True And Target <> "" Then
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = -0.15
        End If
    End With
    
End Sub

.

 

[sirkülasyon]

Ömer abi
başka sayfada Kod sıkıntısız çalışıyor ancak kendi sayfasına aldığım zaman

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Row > 4 And Target.Column = 9 Then
    If Target.Value <> "" Then
        If MsgBox("KDV Eklensin mi?", vbYesNo, "ASKM") = vbYes Then
            
            Target.Offset(0, 1) = Format(WorksheetFunction.Round((Target * 1.08), 2), "#,##0.00")

            Target.Offset(0, 2) = Format(WorksheetFunction.Round((Target.Offset(0, 1) - Target), 2), "#,##0.00")
            Target.Offset(0, 3) = Format(WorksheetFunction.Round((Target.Offset(0, 2) / 2), 2), "#,##0.00")
            Target.Offset(0, 4) = Format(WorksheetFunction.Round((Target), 2), "#,##0.00")
        Else
            Target.Offset(0, 4) = Format(WorksheetFunction.Round((Target), 2), "#,##0.00")
            Target.Offset(0, 1) = ""
            Target.Offset(0, 2) = ""
            Target.Offset(0, 3) = ""
          
        End If
    Else
        Target.Offset(0, 1) = Empty
    End If
End If
End Sub

makrosu var olduğu için

Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, [H5:H150]) Is Nothing Then Exit Sub
    
    If Target.Count > 1 Then Exit Sub
    With Cells(Target.Row, "A").Resize(1, 27).Interior
        .ColorIndex = xlNone
        If IsNumeric(Target) = True And Target <> "" Then
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = -0.15
        End If
    End With
    
End Sub

kodunu modüle eklediğim de

Private Sub Worksheet_Change(ByVal Target As Range)

kısmı hata veriyor bu sebeple makro çalışmıyor.

Allah sizden razı olsun. Özür dileyerek yukarıda yer alan Private Sub Worksheet_Change(ByVal Target As Range) ile başlayan kodları birleştirebilir misiniz?

 

[Ömer]

Bu şekilde deneyin.

Private Sub Worksheet_Change(ByVal Target As Range)

    On Error Resume Next
    If Target.Row > 4 And Target.Column = 9 Then
        If Target.Value <> "" Then
            If MsgBox("KDV Eklensin mi?", vbYesNo, "ASKM") = vbYes Then
                
                Target.Offset(0, 1) = Format(WorksheetFunction.Round((Target * 1.08), 2), "#,##0.00")
    
                Target.Offset(0, 2) = Format(WorksheetFunction.Round((Target.Offset(0, 1) - Target), 2), "#,##0.00")
                Target.Offset(0, 3) = Format(WorksheetFunction.Round((Target.Offset(0, 2) / 2), 2), "#,##0.00")
                Target.Offset(0, 4) = Format(WorksheetFunction.Round((Target), 2), "#,##0.00")
            Else
                Target.Offset(0, 4) = Format(WorksheetFunction.Round((Target), 2), "#,##0.00")
                Target.Offset(0, 1) = ""
                Target.Offset(0, 2) = ""
                Target.Offset(0, 3) = ""
              
            End If
        Else
            Target.Offset(0, 1) = Empty
        End If
    End If
    
    If Target.Row > 4 And Target.Column = 8 Then
        If Target.Count > 1 Then Exit Sub
        With Cells(Target.Row, "A").Resize(1, 27).Interior
            .ColorIndex = xlNone
            If IsNumeric(Target) = True And Target <> "" Then
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = -0.15
            End If
        End With
    End If
    
End Sub

.

 

[sirkülasyon]

Ömer Abi
Teşekkür Ederim.
Ellerine Sağlık. Hakkını Helal Et.