İki makro kodun birleştirilmesi

[klop01]

Hazır ve düzgün çalışan iki makro kodu var.
Birisi aktif hücre, satır ve sütun renklendiriyor.
İkincisi tıklanan hücredeki yazıyı büyütüyor.
BU İKİ KOD BİRLEŞTİRİLİP AYNI ALANDA İŞLER HALE GETİRİLEBİLİR Mİ?

Aktif hücre, satır ve sütun renklendirme kodu:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("B3:AO64")) Is Nothing Then
    Cells.FormatConditions.Delete
    Exit Sub
End If

Dim Satır As Range, Sütun As Range
    
    Set Satır = Range(Cells(ActiveCell.Row, 2), Cells(ActiveCell.Row, 41))
    Set Sütun = Range(Cells(Target.Row, ActiveCell.Column), Cells(3, ActiveCell.Column))
    
    Cells.FormatConditions.Delete
    
    With Satır
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:=1
        .FormatConditions(1).Font.Bold = True
        .FormatConditions(1).Interior.ColorIndex = 8
    End With
    
    With Sütun
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:=1
        .FormatConditions(1).Font.Bold = True
        .FormatConditions(1).Interior.ColorIndex = 8
    End With
    
    With ActiveCell
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:=1
        .FormatConditions(1).Font.Bold = True
        .FormatConditions(1).Interior.ColorIndex = 6
    End With
End Sub

Tıklanan hücredeki yazıyı büyüten kod:

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Son
With [B3:AO64]
    Cells.Font.Size = 10
    Cells.Font.Italic = False
End With
If Intersect(Target, [B3:AO64]) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
If Not IsEmpty(Target) Then
Target.Font.Size = 20
Target.Font.Italic = True
End If
Son:
Application.ScreenUpdating = True
End Sub

 

[Mahmut Bayram]

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("B3:AO64")) Is Nothing Then
    Cells.FormatConditions.Delete
    Exit Sub
End If

Dim Satır As Range, Sütun As Range
    
    Set Satır = Range(Cells(ActiveCell.Row, 2), Cells(ActiveCell.Row, 41))
    Set Sütun = Range(Cells(Target.Row, ActiveCell.Column), Cells(3, ActiveCell.Column))
    
    Cells.FormatConditions.Delete
    
    With Satır
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:=1
        .FormatConditions(1).Font.Bold = True
        .FormatConditions(1).Interior.ColorIndex = 8
    End With
    
    With Sütun
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:=1
        .FormatConditions(1).Font.Bold = True
        .FormatConditions(1).Interior.ColorIndex = 8
    End With
    
    With ActiveCell
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:=1
        .FormatConditions(1).Font.Bold = True
        .FormatConditions(1).Interior.ColorIndex = 6
    End With
    
On Error GoTo Son
With [B3:AO64]
    Cells.Font.Size = 10
    Cells.Font.Italic = False
End With

If Intersect(Target, [B3:AO64]) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
If Not IsEmpty(Target) Then
Target.Font.Size = 20
Target.Font.Italic = True
End If
Son:
Application.ScreenUpdating = True
End Sub

 

[klop01]

Sayın Mahmut Bayram,
Teşekkür ederim, kod sorunsuz çalışıyor.