Sub Reorganize()

Dim H As Long 'Height of table
Dim A As Long 'Start point
Dim B As Long 'Finish point
Dim i As Long 'to roll

H = Cells(Rows.Count, 1).End(xlUp).Row
If H < 2 Then Exit Sub
B = H

For i = H To 2 Step -1
     If Cells(i, 2).Value <> Cells(i + 1, 2).Value Then
         A = i + 1
         Rows(A).Insert
         Range(Cells(A, 1), Cells(A, 6)).Interior.Color = 49407
         B = i
     End If
Next i

H = Cells(Rows.Count, 1).End(xlUp).Row + 1
A = 2

For i = 2 To H Step 1
     If Cells(i, 1).Value = "" Then
         B = i - 1
         Cells(i, 3).Value = B - A + 1
         Cells(i, 5).Value = Application.WorksheetFunction.Sum(Range(Cells(A, 5), Cells(B, 5)))
         A = i + 1
     End If
Next i

End Sub

Sub Reorganize2()

Dim H As Long 'Height of table
Dim A As Long 'Start point
Dim B As Long 'Finish point
Dim i As Long 'to roll

H = Cells(Rows.Count, 1).End(xlUp).Row
If H < 2 Then Exit Sub
B = H: Range("F2:G" & H).Clear
[F1:G1].Value = Array("Кол-во домов", "Кол-во жителей")
Range("F1").Copy: Range("G1").PasteSpecial Paste:=xlPasteFormats

For i = H To 2 Step -1
     If Cells(i, 2).Value <> Cells(i + 1, 2).Value Then
         A = i + 1: Rows(A).Insert
         Range(Cells(A, 1), Cells(A, 6)).Interior.Color = 49407
         B = i
     End If
Next i

H = Cells(Rows.Count, 1).End(xlUp).Row + 1: A = 2

For i = 2 To H Step 1
     If Cells(i, 1).Value = "" Then
         B = i - 1
         Cells(i, 3).Value = B - A + 1: Cells(A, 6).Value = B - A + 1
         Cells(i, 5).Value = Application.WorksheetFunction.Sum(Range(Cells(A, 5), Cells(B, 5)))
         Cells(A, 7).Value = Cells(i, 5).Value
         Range(Cells(A, 6), Cells(i, 6)).Merge: Range(Cells(A, 7), Cells(i, 7)).Merge
         A = i + 1
     End If
Next i

With Range(Cells(2, 6), Cells(H, 7))
     For i = 7 To 12: .Borders(i).LineStyle = 1: Next i
     .HorizontalAlignment = xlCenter: .VerticalAlignment = xlCenter
     .Font.Bold = True
     Columns("F:G").ColumnWidth = 16
End With

End Sub