VBA, Impedir cambiar datos en celdas.

Supongo que también sería un problema que a un rango 3 (ya establecido) alguien (por error) lo cambie a rango 5, con el consiguiente cambio de formato. Para evitar esto yo  «juego» con el color de la fuente y con el color del fondo:

 ·  Fuente 1 = RGB(1,1,1)

 ·  Fuente 2 = RGB(2,2,2)

 ·  Fuente 3 = RGB(3,3,3)

 ·  Fuente 4 = RGB(4,4,4)

 ·  Fuente 5 = RGB(5,5,5) 

 ·  AC1:AG1  =   65793, 131586, 197379, 263172 y 328965  (son los tonos de fuente).

Los cinco son tonos de negro que (a nivel humano) no se diferencian, mediante el tono de fuente (el código) «impide» que se alteren  los valores.

Con este código (en un módulo ordinario) obtienes los rangos de AA1:AA22, ...

Sub Macro2()

  Dim f&

  With Range("AA1:AA2")

    .MergeCells = True

    .Font.color = RGB(1, 1, 1)

    Range("AA1").Value = 1

  End With

    For f = 3 To 18 Step 5

    With Cells(f, "AA").Resize(5)

      .MergeCells = True

      .Font.color = RGB((f + 7) / 5, (f + 7) / 5, (f + 7) / 5)

      .HorizontalAlignment = xlCenter

      .VerticalAlignment = xlCenter

      Cells(f, "AA").Value = (f + 7) / 5

    End With

  Next f

End Sub

...  con sus correspondientes colores de fuente. Aplícale manualmente los colores de relleno que prefieras.

 · Cuando necesites  (por ejemplo) un rango 4, selecciona AA13:AA17, das a copiar y pegas en destino (B13:B17).

 ·  Si cambias el color de uno de los rangos origen, en destino permanecen sin cambio hasta que re-escribas su valor, solo aceptará el que le pertenece por color de fuente.

En el módulo de la hoja:

Private Sub Worksheet_Change(ByVal Target As Range)

  Dim i#, fuente$

  On Error Resume Next

  fuente = Target.Font.color

  i = WorksheetFunction.Match(Target.Font.color, Range("AC1:AG1"))

  Application.EnableEvents = False

  Select Case i

    Case 1 To 5 ' fuente con tonos negros especiales.

      Target.Value = i

      Target.Interior.color = Range("AA1").Offset(i * 5 - 5).Interior.color

  End Select

  Application.EnableEvents = True

End Sub