Macro para marcar celdas de color

Para que podamos ayudarte mejor pudieras compartir o lograras colocar más información de como funciona ese formulario, ya que se pueden cazar los datos del rango de días y añadir un dato más a donde se guarden, colocar una fórmula del tipo dia360 para saber cuantos días son, asignarle una variable tipo "cantidaddias" y entonces cuando tu seleccionas el un día del calendario sobre cualquier habitación, se ejecute el formulario y tome el rango activo como una variable offset, entonces pueda añadir "cantidaddias" en R1C1 a la derecha y entonces si, rellene de color las celdas seleccionadas.

Bueno, es lo que se me ocurre, pero si no tenemos más información sera más rollo escribir código que luego tendrías que modificar. Por el nivel de la app que desarrollas imagino que me entenderás a la perfección y lograras ejecutarlo sin problemas.

Exactamente el código que tiene esa app es esta

Private Sub Inrango(Target As Range)
On Error Resume Next

Dim KeyCells As Range, r As VbMsgBoxResult

Set KeyCells = Range("$E$9:$S$48")
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
If ActiveCell.Value = -1 Then
Call Prohibido("El Salon ya ha sido reservado para esta fecha")
Else
Load Reservar
Reservar.Show
End If

tiene formato condicional dependiendo el numero que asignes si es -1 rojo y hasi
Exit Sub
End If
Set KeyCells = Range("$B$9:$B$48")
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
ActiveSheet.Unprotect password:=Keysheet
ActiveSheet.Range("$A$7:$C$48").AutoFilter Field:=2, Criteria1:=ActiveCell.Value
Rows("7:7").RowHeight = 14
Rows("8:8").RowHeight = 14
ActiveSheet.Protect password:=Keysheet, DrawingObjects:=True, Contents:=True, Scenarios:=True
End If
End Sub

Esta macro colorea un rango en automático, tendría que personalizarla de acuerdo a su archivo

Para que en automático lo haga al momento de guardar el registro. Si no tiene inconveniente de enviarme un archivo de ejemplo de su archivo podría intentar personalizarlo

´-------------------------------------------------------------------------------------

Private Sub Worksheet_Change(ByVal Target As Range)
'Por.DAM
If Not Intersect(Target, Range("A:A")) Is Nothing Then
    If Target.Count > 1 Then 'Exit Sub
        For Each c In Selection
            If c = 2 Then
                Range(Cells(c.Row, "B"), Cells(c.Row, "F")).Interior.ColorIndex = 4
            Else
                Range(Cells(c.Row, "B"), Cells(c.Row, "F")).Interior.ColorIndex = xlNone
            End If
        Next
    Else
        If Target = 2 Then
            Range(Cells(Target.Row, "B"), Cells(Target.Row, "F")).Interior.ColorIndex = 4
        Else
            Range(Cells(Target.Row, "B"), Cells(Target.Row, "F")).Interior.ColorIndex = xlNone
        End If
    End If
End If
End Sub