几百个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
此内容由惯性聚合(RSS阅读器)自动聚合整理，仅供阅读参考。 原文来自 — 版权归原作者所有。