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

时间慢慢的流淌，人生有风雨阳光，