Sub ttt()
    Dim lrw&, plsd&, rs&, dcl&, prch&, Rng As Range
    With Лист1
        lrw = .Range("A" & Rows.Count).End(xlUp).Row
        For Each Rng In .Range("A2:A" & lrw).SpecialCells(xlVisible).Areas
            plsd = plsd + Application.WorksheetFunction.CountIf(Rng, "Order placed")
            rs = rs + Application.WorksheetFunction.CountIf(Rng, "Under consideration") + Application.WorksheetFunction.CountIf(Rng, "Under Customer's review") + Application.WorksheetFunction.CountIf(Rng, "Technical evaluation")
            dcl = dcl + Application.WorksheetFunction.CountIf(Rng, "Rejected*") + Application.WorksheetFunction.CountIf(Rng, "*unacceptable")
            prch = prch + Application.WorksheetFunction.CountIf(Rng, "*hold") + Application.WorksheetFunction.CountIf(Rng, "*refused*")
        Next Rng
        .Range("D1") = "На рассмотрении: " & rs
        .Range("G1") = "Реализовано: " & plsd
        .Range("J1") = "Отклонено: " & dcl
        .Range("M1") = "Прочие: " & prch
        With .Range("D1")
            .Font.Color = -3407872
            .Font.Bold = True
        End With
        With .Range("G1")
            .Font.Color = -16776961
            .Font.Bold = True
        End With
        With .Range("J1")
            .Font.Color = -11489280
            .Font.Bold = True
        End With
    End With
End Sub