Excel分类汇总宏(VBA)

几百个Sheet要进行分类汇总的操作，并且需要将汇总的数据拷贝到一张空sheet。这就是MM的需求，不多解释了。能用的上就复制吧，细节问题copy者请自行修改。

Sub mSubtotal()
    Dim LastRow As Long
    Dim sh As Worksheet
    For Each sh In ThisWorkbook.Worksheets
        Rem 分类汇总
        On Error GoTo err
        If sh.Name <> "pumaboyd" Then
            LastRow = sh.Range("A65536").End(xlUp).Row 
            sh.Range("A2:AE" & LastRow).Sort Key1:=sh.Range("b2"), Order1:=xlDescending, Header:= _
            xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            SortMethod:=xlPinYin, DataOption1:=xlSortNormal
            sh.Range("A2:AE" & LastRow).Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(5, 12, 14), Replace:=True, PageBreaks:=False, SummaryBelowData:=True   sh.Outline.ShowLevels RowLevels:=2
            sh.Activate   Cells.Select    
    		Selection.EntireRow.Hidden = False
            sh.Range("B3").Select   Selection.SpecialCells(xlCellTypeVisible).Select
            Selection.Copy   Sheets("pumaboyd").Activate
            Sheets("pumaboyd").[B65536].End(xlUp).Offset(1, 0).Value = sh.Name
            Sheets("pumaboyd").[B65536].End(xlUp).Offset(1, -1).Select
            Sheets("pumaboyd").Paste   End If   err:   Debug.Print err.Description
'msgbox Err.Description
          Resume Next   Next     End Sub