Sub 集計()
Application.ScreenUpdating = False
With Sheets("Sheet2")
Sheets("Sheet1").Range("B:F").Copy .Range("A1")
.Range("A1").CurrentRegion.Sort Key1:=.Range("A1"), _
Order1:=xlAscending, Header:=xlYes, Orientation:=xlSortColumns
.Range("A1").Subtotal 1, xlSum, Array(3, 4)
.Cells.ClearOutLine
.Activate
End With
Application.ScreenUpdating = True
End Sub