Sub rsrasc()
    Dim i As Long, ws As Worksheet
    Dim rng As Range, cel As Range
    Dim lr As Long, dte As Date, colour As String
    
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

For i = 1 To Sheets.Count
    With Sheets(i)
        dte = .Range("A4").Value
        colour = .Range("A4").Interior.Color
        lr = .Range("B" & .Rows.Count).End(xlUp).Row
        For Each cel In .Range("C6:C" & lr)
            If cel.Offset(, -1) <> "" Then
                With cel
                    .NumberFormat = "d-mmm-yy"
                    .Interior.Color = colour
                    .Value = dte
                End With
            End If
        Next cel
    End With
Next i

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub