Sub Macros1()
    Dim city As String
    Dim clin As String
    Dim Row2 As Long
    Dim RowF As Long
    
    Dim rngF As Range
    Dim rng1 As Range
    Dim rng2 As Range
    Dim cel1 As Range
    
    Set rng1 = ThisWorkbook.Worksheets("Sheet1").Range("A1:A6")
    Set rng2 = ThisWorkbook.Worksheets("Sheet2").Range("A:D")
    rng2.ClearContents
    
    rng2.Cells( 1 ,  2 ).Value = "gospital"
    rng2.Cells( 1 ,  3 ).Value = "bolnica"
    rng2.Cells( 1 ,  4 ).Value = "klinika"
    rng2.Range(Cells( 1 ,  2 ), Cells( 1 ,  4 )).Font.Bold = True
    
    Application.ScreenUpdating = False
    
    Row2 =  1 
    For Each cel1 In rng1
        city = cel1.Offset(,  1 ).Value
        clin = cel1.Value
        With rng2
            Set rngF = .Columns( 1 ).Find(city)   ' зависит от Range("A:D")
            If rngF Is Nothing Then
                Row2 = Row2 +  1 
                RowF = Row2
                .Cells(RowF,  1 ).Value = city
                .Cells(RowF,  5 ).Font.Bold = True
                .Cells(RowF,  5 ).FormulaR1C1 = "=SUM(RC[-3]:RC[-1])"
                .Range(Cells(RowF,  2 ), Cells(RowF,  4 )).HorizontalAlignment = xlCenter
                .Range(Cells(RowF,  2 ), Cells(RowF,  4 )).Value = Application.Transpose(Array( 0 ,  0 ,  0 ))
            Else
                RowF = rngF.Row
            End If
            
            Select Case clin
            Case .Cells( 1 ,  2 ).Value: .Cells(RowF,  2 ).Value =  1 
            Case .Cells( 1 ,  3 ).Value: .Cells(RowF,  3 ).Value =  1 
            Case .Cells( 1 ,  4 ).Value: .Cells(RowF,  4 ).Value =  1 
            End Select
        End With
        
    Next
    
    rng2.Range(Cells(RowF +  1 ,  2 ), Cells(RowF +  1 ,  4 )).Font.Bold = True
    rng2.Range(Cells(RowF +  1 ,  2 ), Cells(RowF +  1 ,  4 )).HorizontalAlignment = xlCenter
    rng2.Range(Cells(RowF +  1 ,  2 ), Cells(RowF +  1 ,  4 )).FormulaR1C1 = "=SUM(R[-4]C:R[-1]C)"
    
    Application.ScreenUpdating = True
End Sub