Hallo,

auch das sollte relativ leicht zu bewältigen sein:

Option Explicit

Private Function DeleteAF(ByVal lngRow As Long) As Boolean
    Dim wsh As Worksheet
    Dim rng As Range
    Dim iCol As Integer
    Dim bEmpty As Boolean
    Set wsh = ActiveWorkbook.Worksheets(1)
    bEmpty = True
    DeleteAF = CBool(Not wsh.Cells(lngRow, 3).Value = Date)
    If DeleteAF Then
        For iCol = 32 To 3 Step -1
            With wsh.Cells(lngRow, iCol)
                If Not .Locked Or Not wsh.ProtectContents Then
                    If iCol = 3 Then
                        If Not bEmpty Then
                            If lngRow = 2 Then
                                .Value = Date
                            Else
                                .ClearContents
                                If Not wsh.ProtectContents Then
                                    .NumberFormat = "General"
                                End If
                            End If
                        End If
                    Else
                        If IsEmpty(.Offset(ColumnOffset:=-1).Value) Then
                            .ClearContents
                            If Not wsh.ProtectContents Then
                                .NumberFormat = "General"
                            End If
                        Else
                            .Value = .Offset(ColumnOffset:=-1).Value
                            bEmpty = False
                        End If
                    End If
                End If
            End With
        Next
    End If
End Function
 
Sub FixAll()
    Dim iRow As Integer
    Dim myCalc As XlCalculation
    myCalc = Application.Calculation
    Application.Calculation = xlManual
    For iRow = 2 To 30
        If Not DeleteAF(iRow) Then
            MsgBox "Der Befehl wurde heute bereits ausgeführt!", vbCritical
            Exit For
        End If
    Next
    Application.Calculate
    Application.Calculation = myCalc
End Sub

Hierbei muss allerdings die Einschränkung in Kauf genommen werden ,dass Zahlenformate nicht übernommen werden.

Alternativ könnte man auch den Blattschutz in der Sub FixAll am Anfang aufheben und am Ende wieder setzen:

ActiveSheet.Unprotect ' Schutz Aufheben

'...

' Schutz setzen:
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

Getestet mit Excel 2013

LG, Ben