Sub summary()
      Dim rng As Range, rngC As Range
      Dim lngCol As Long, Spa_1 As Long, Spa_2 As Long
       
      On Error Resume Next
      Application.ScreenUpdating = False
       
      With ActiveSheet
        Set rng = .ListObjects(1).Range
        If rng Is Nothing Then Exit Sub
        .Copy after:=ActiveSheet
      End With
      With ActiveSheet
        .Name = rng.Parent.Name & " Summary"
        If .AutoFilterMode Then .ShowAllData
        Spa_1 = rng.Column + rng.Columns.Count
        Spa_2 = Spa_1 + 1
        .Range(.Cells(1, Spa_1), .Cells(1, Spa_2)) = "XXX"
        .Range(.Cells(2, Spa_1), .Cells(rng.Rows.Count - 1, Spa_1)).FormulaR1C1 = _
              "=IF(OR(RC[-1]="""",COUNTIF(R2C[-1]:RC[-1],RC[-1])=1),""x"","""")"
        .Range(.Cells(2, Spa_2), .Cells(rng.Rows.Count - 1, Spa_2)).FormulaR1C1 = _
              "=SUMIF(C[-2]:C[-2],RC[-2],C[-3]:C[-3])"
        Set rngC = .Columns(Spa_1).SpecialCells(xlCellTypeFormulas)
        rngC = rngC.Value
        Set rngC = .Columns(Spa_2).SpecialCells(xlCellTypeFormulas)
        rngC = rngC.Value
        For Each rngC In .Range(.Cells(2, Spa_1), .Cells(rng.Rows.Count - 1, Spa_1)) _
           .SpecialCells(xlCellTypeConstants)
          rngC.Offset(0, -2) = rngC.Offset(0, 1).Value
        Next
        .Cells(1, Spa_1).CurrentRegion.Sort .Cells(1, Spa_1), xlAscending, Header:=xlYes
        Set rngC = .Range(.Cells(2, Spa_1), .Cells(rng.Rows.Count - 1, Spa_1)) _
                 .SpecialCells(xlCellTypeBlanks)
        If Not rngC Is Nothing Then rngC.EntireRow.Delete
        .Columns(Spa_2).Delete
        .Columns(Spa_1).Delete
      End With
       
       
      Application.ScreenUpdating = True
      Set rng = Nothing
      Set rngC = Nothing
  End Sub