Lås celle på baggrund af tekst farve

Manglede lige at nævne, at VBA koden også gerne må beskytte celler som indeholde en formel/henvisning til andre celler.

Skal det ske på "kommando" eller ved ændring?

Det skal ske på kommando vha, af en knap, koden skal gælde for Fane 1 og Fane 2.

Ok vender tilbage

Det lyder meget fornemt. Tak for det.

Version 1:

Rem VBA-kode placeres i ThisWorkbook
Rem ================================
Const faneNavne = "Ark1,Ark2"
Const tekstFarveRød = 255
Const adgangskode = "xx"

Dim antalRæk As Integer, antalKol As Integer
Public Sub låsCellerPåBetingelser()
Dim f As Integer, v As Variant, arkNavn As String, cc
    v = Split(faneNavne, ",")
    For f = 0 To UBound(v)
        arkNavn = v(f)
       
        ActiveWorkbook.Sheets(arkNavn).Activate
        antalRæk = ActiveCell.SpecialCells(xlLastCell).Row
        antalKol = ActiveCell.SpecialCells(xlLastCell).Column
       
        For Each cc In Range(Cells(1, 1), Cells(antalRæk, antalKol))
Rem Er der rød tekst
            If cc.Font.Color = tekstFarveRød Then
                cc.Locked = True
            Else
                If cc.HasFormula = True Then
                    cc.Locked = True
                Else
                    cc.Locked = False
                End If
            End If
        Next cc
        ActiveWorkbook.Sheets(arkNavn).Protect adgangskode
    Next f

Jeg har desværre problemer med koden.

Nedenstående del har jeg indsat i 'Denne_projektmappe':

Rem VBA-kode placeres i ThisWorkbook
Rem ================================
Const faneNavne = "Ark1,Ark2"
Const tekstFarveRød = 255
Const adgangskode = "xx"

Denne del af koden har jeg indsat i et modul:
Public Sub låsCellerPåBetingelser()
Dim f As Integer, v As Variant, arkNavn As String, cc
    v = Split(faneNavne, ",")
    For f = 0 To UBound(v)
        arkNavn = v(f)
       
        ActiveWorkbook.Sheets(arkNavn).Activate
        antalRæk = ActiveCell.SpecialCells(xlLastCell).Row
        antalKol = ActiveCell.SpecialCells(xlLastCell).Column
       
        For Each cc In Range(Cells(1, 1), Cells(antalRæk, antalKol))
Rem Er der rød tekst
            If cc.Font.Color = tekstFarveRød Then
                cc.Locked = True
            Else
                If cc.HasFormula = True Then
                    cc.Locked = True
                Else
                    cc.Locked = False
                End If
            End If
        Next cc
        ActiveWorkbook.Sheets(arkNavn).Protect adgangskode
    Next f
   
End Sub

Det er en kode.

Prøv at samle det hele i 'Denne_projektmappe'

Så lykkedes det. Tak for hjælpen

Jeg var desværre lidt for hurtig.

Koden fungerer fint nok. Problemet er, at det ikke er muligt, efter at makroen er kørt, at indtaste i celler der er blanke eller som ikke indehold rød tekst eller en formel.

Kan godt indtaste i celler, der er uden forbeholdet - så ?

Nej, desværre

PS: Nok fordi jeg kun har prøvet indenfor dataområder på arkene.
Udenfor er der beskyttelse!

Er der mulighed for, at dette område kan blive gjort åben?

Jeg får en fejl i makroen, når jeg køre den flere gange?

Du kan prøve manuelt at låse alle celler op.
Tryk på lille firkant over 1 tallet, for at markerer alle celler
Højre-klik på en celle --> Formater celler...
Beskyttelse --> fjern flueben i: låst --> tryk OK

Eller måske tilføje: Cells.Locked = False
i starten af makroen, lige under:
ActiveWorkbook.Sheets(arkNavn).Activate

Formater / Beskyttelse / Låst / fjern "flueben"
Indsæt data i ubrugte celler.
Kør makroen - herefter vil også "nye celler" være underlagt de givne regler.

Nogen afklaring?