Excel分类汇总宏(VBA)

pumaboyd — Mon, 22 Dec 2008 01:06:15 +0000

几百个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

鱼杆鱼堂 » excel

Excel分类汇总宏(VBA)