Como contar los 10 primeros diagnósticos mayores y el resto de los diagnósticos con macros.

Esta es la imagen con el resultado de la macro

y esta es la macro para que funcione adecuamente crea una hoja que se llame hoja1

Sub ejecuta_resumen()
crear_tabla
copiar_tabla
End Sub
Sub crear_tabla()
 Dim Sheet1 As Worksheet
  Dim Sheet2 As Worksheet
  Dim PTCache As PivotCache
  Dim TabDin As PivotTable
  Dim PRange As Range
  Dim FinalRow As Long
    Set h1 = Worksheets("hoja1")
    h1.Select
    h1.Cells.Clear
    Set Sheet1 = Worksheets("base datos")
    Set PRange = Sheet1.Range("a1").CurrentRegion
    Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=PRange.Address)
    Set TabDin = PTCache.CreatePivotTable(TableDestination:=h1.Range("a1"), TableName:="PivotTable3")
    TabDin.Format xlReport7
    TabDin.ManualUpdate = True
    With TabDin.PivotFields("diagnostico")
    .Orientation = xlRowField
    .Position = 1
    .Name = "diagnostico"
  End With
  With TabDin.PivotFields("diagnostico")
    .Orientation = xlDataField
    .Function = xlCount
    .Position = 1
    .NumberFormat = "#,##0"
    .Name = "N."
  End With
    TabDin.ManualUpdate = False
End Sub
Sub copiar_tabla()
Set h1 = Worksheets("hoja1")
h1.Range("a:b").Copy: h1.Range("a:b").PasteSpecial xlValues
filas = Sheets("base datos").Range("a1").CurrentRegion.Rows.Count
Set base = Sheets("base datos").Range("a2").Resize(filas - 1, 2)
Set datos = Range("a1").CurrentRegion
With datos
    filas = .Rows.Count
    Set datos = .Rows(2).Resize(filas - 3)
    .Sort key1:=Range(.Columns(2).Address), order1:=xlDescending
    Set mejores10 = .Resize(10, 2)
    suma = WorksheetFunction.Sum(datos.Columns(2))
    suma1 = WorksheetFunction.Sum(mejores10.Columns(2))
    suma2 = base.Rows.Count
    sin_diag = suma2 - suma
    diferencia = suma - suma1
    .Rows(11).Resize(filas, 2).Clear
    .Cells(11, 1) = "Todas las demas"
    .Cells(11, 2) = diferencia
    .Cells(12, 1) = "Sin diagnostico"
    .Cells(12, 2) = sin_diag
    Set datos = .CurrentRegion
    filas = .Rows.Count
    Set datos = .Rows(2).Resize(filas - 1)
    .Columns(3).Formula = "=" & .Cells(2).Address(0, 0) & "/" & suma2
    .Columns(3).Value = .Columns(3).Value
    .Columns(3).NumberFormat = "0.00%"
    . EntireColumn. AutoFit
    .Cells(13, 2) = WorksheetFunction. Sum(. CurrentRegion. Columns(2))
    .Cells(13, 3) = WorksheetFunction. Sum(. CurrentRegion. Columns(3))
    .Cells(13, 1) = "Total General"
    . Cells(13, 1).Resize(1, 3). Font.Bold = True
    . Cells(13, 1).Resize(1, 3). Font.ColorIndex = 1
    . Cells(13, 1).Resize(1, 3). Interior.ColorIndex = 20
    .Cells(0, 1).Resize(1, 3). Font.Bold = True
    .Cells(0, 1).Resize(1, 3). Font.ColorIndex = 1
    .Cells(0, 1).Resize(1, 3). Interior.ColorIndex = 20
    .Cells(0, 1) = "CAUSAS DE MORBILIDAD"
    .Cells(0, 2) = "N"
    .Cells(0, 3) = "%"
End With
Set base = Nothing: Set datos = Nothing
End Sub