Sub Rearrange()
    Dim LR As Long
    Dim Found As Range
    Dim MyFound As Long
    
    Const sFormula As String = "=COUNTIF(Status!$A$2:$A$#, B$1)"
    Const sFormula1 As String = "=COUNTIF(Status!$B$2:$B$#, D$1)"
    
    Set Found = Columns(1).Find(What:=Format(Date, "d-mmm-yy"), LookIn:=xlValues)
    
    MyFound = Found.Row - 1
    
    LR = Sheets("Status").Range("A" & Rows.Count).End(xlUp).Row
    
    Application.ScreenUpdating = False
    
    With Sheets("Data").Range("B" & Found.Row).Resize(, 2)
        .Formula = Replace(sFormula, "#", LR)
        .Value = .Value
    End With
    
    With Sheets("Data").Range("D" & Found.Row).Resize(, 3)
        .Formula = Replace(sFormula1, "#", LR)
        .Value = .Value
    End With
    
    Application.ScreenUpdating = True
End Sub