Makro ile Koşullu Biçimlendirme

[srctn]

Hocam şu tablodaki durumda ne yapabilirim? çalışma durumu "i" veya "izinli" ise ilgili satırda c sütunundan m sütununa kadar birleştirip içersine raporlu yazmak istiyorum makro olmadan mümkün mü? makro ile hücreleri birleştirdiğimizi farzedelim bu durumda hücrenin içindeki veriler Raporlu yazılınca silinir mi? https://drive.google.com/file/d/1Y3LyF9fcTx8xIS_4uGl81Xq16sVj_Ojt/view?usp=sharing

 

[çıtır]

Sayfa kodu olarak deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [o4:o400]) Is Nothing Then Exit Sub
If Range("O" & Target.Row) = "İ" Or Range("O" & Target.Row) = "İzinli" Then
Range(Cells(Target.Row, 3), Cells(Target.Row, 13)).Merge
Range(Cells(Target.Row, 3), Cells(Target.Row, 13)) = "RAPORLU"
Range(Cells(Target.Row, 3), Cells(Target.Row, 13)).Font.Bold = True
Range(Cells(Target.Row, 3), Cells(Target.Row, 13)).Borders.LineStyle = xlContinuous
Range(Cells(Target.Row, 3), Cells(Target.Row, 13)).HorizontalAlignment = xlCenter
Range(Cells(Target.Row, 3), Cells(Target.Row, 13)).VerticalAlignment = xlCenter
End If
If Range("O" & Target.Row) <> "İ" Or Range("O" & Target.Row) <> "İzinli" Then
Range(Cells(Target.Row, 3), Cells(Target.Row, 13)).UnMerge
Range(Cells(Target.Row, 3), Cells(Target.Row, 13)) = ""
End If
End Sub

 

[srctn]

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [o4400]) Is Nothing Then Exit Sub
If Range("O" & Target.Row) = "İ" Or Range("O" & Target.Row) = "İzinli" Then
Range(Cells(Target.Row, 3), Cells(Target.Row, 13)).Merge
Range(Cells(Target.Row, 3), Cells(Target.Row, 13)) = "RAPORLU"
Range(Cells(Target.Row, 3), Cells(Target.Row, 13)).Font.Bold = True
Range(Cells(Target.Row, 3), Cells(Target.Row, 13)).Borders.LineStyle = xlContinuous
Range(Cells(Target.Row, 3), Cells(Target.Row, 13)).HorizontalAlignment = xlCenter
Range(Cells(Target.Row, 3), Cells(Target.Row, 13)).VerticalAlignment = xlCenter
End If
If Range("O" & Target.Row) <> "İ" Or Range("O" & Target.Row) <> "İzinli" Then
Range(Cells(Target.Row, 3), Cells(Target.Row, 13)).UnMerge
Range(Cells(Target.Row, 3), Cells(Target.Row, 13)) = ""
End If
End Sub

Teşekkür ederim çalışıyor ama Raporlu yazısı geliyor ardından yazının yer alacağı tüm hücreleri temizliyor.

 

[emsey]

Yalnız bu makro ile koşullu biçimlendirme değil, makro ile hücre birleştirme değil mi