Hallo Boby,

in dem Fall muss nur eine kleine Ergänzungs vorgenommen werden:

Option Explicit

Sub DeleteAF(ByVal lngRow As Long)
    Dim wsh As Worksheet
    Dim rng As Range
    Dim iCol As Integer
    Dim bEmpty As Boolean
    Set wsh = ActiveWorkbook.Worksheets(1)
    bEmpty = True
    For iCol = 32 To 3 Step -1
        With wsh.Cells(lngRow, iCol)
            If iCol = 3 Then
                If Not bEmpty Then
                    If lngRow = 2 Then
                        .Value = Date
                    Else
                        .ClearContents
                        .NumberFormat = "General"
                    End If
                End If
            Else
                If IsEmpty(.Offset(ColumnOffset:=-1).Value) Then
                    .ClearContents
                    .NumberFormat = "General"
                Else
                    .Value = .Offset(ColumnOffset:=-1).Value
                    bEmpty = False
                End If
            End If
        End With
    Next
End Sub

Sub FixAll()
    Dim iRow As Integer
    Dim myCalc As XlCalculation
    myCalc = Application.Calculation
    Application.Calculation = xlManual
    For iRow = 2 To 30
        DeleteAF iRow
    Next
    Application.Calculate
    Application.Calculation = myCalc
End Sub

Das die Laufzeit so lange ist, kann an den Formeln liegen. Standardmäßig werden die Formeln nach jeder Änderung automatisch neu berechnet. Je nach Umfang der Formeln kann es daher etwas dauern.

Beim Aufruf von "FixAll" wird die Automatische Berechnung temporär auf Manuell umgestellt.

In der Variable myCalc wird das zuvor eingestellte Verfahren gespeichert. Mit deren Hilfe wird die Automatische Berechnung am Ende wieder auf das zuvor eingestellte Verfahren zurück gesetzt.

Nun sollte es performanter ablaufen.

Ab der 3. Zeile werden wie gewünschte in der Spalte C keine Inhalte mehr eingetragen. Das Zahlenformat für die Zellen C3 bis max. C30 ist auf "Standard" fstgelegt.

LG, Ben