转载：用VBA生成数据透视表，并复制到新表（示例)
2014-05-04 15:09阅读：
原文地址：
http://www.excelpx.com/forum.php?mod=viewthread&tid=138124
以下代码是我在学习数据透视表过程中编写的代码，供大家借鉴。
Sub test()
Dim DataRng As Range
'定义一个数据范围，用来储存生成数据透视表的数据
Dim MyPivot As Worksheet
'定义一个工作表，存放数据透视表'
Dim MyPivotTable As PivotTable
'定义一个数据透视表，用来储存数据透视表对象”
Dim MyTable As Worksheet
'定义一个工作表，做为汇总表
Dim sh As Worksheet
'定义工作表变量，删除数据透视表时使用
Set DataRng = Range('明细表!A1:E59')
'确定生成数据透视表的数据
'也可以用inputbox方法选择，语句如下
'Set DataRng =
Application.InputBox('请选择需要生成数据透视表的数据', Type:=8)
Set MyPivot = Sheets.Add
'新建一个工作表，用来存放数据透视表
'下面这一句是利用PivotTableWizard方法生成一个空的数据透视表；
Set MyPivotTable =
MyPivot.PivotTableWizard(SourceType:=xlDatabase,
SourceData:=DataRng)
'添加数据透视表行字段和列字段，如果需要同时添加多个行字段或者列字段，用arr函数
MyPivotTable.AddFields
RowFields:=Array('BH', 'XM'), ColumnFields:='MC'
'添加数据透视表数据字段和汇总方法，注意这里需要写完整数据字段“MyPivotTable.PivotFields('JE')”
MyPivotTable.AddDataField
MyPivotTable.PivotFields('JE'), Function:=xlSum
'去掉BH字段中分类汇总功能，Subtotals(1)=false代表将索引
1（自动）为 false，则其他所有值将设置为 False。如果需要分类汇总功能，则设置为true或不要这句；
MyPivotTable.PivotFields('BH').Subtotals(1)
= False
'建一个新表，将所需内容copy到新表
Set MyTable = Sheets.Add
Range(MyPivot.Cells.Find('BH'),
MyPivot.UsedRange.Item(MyPivot.UsedRange.Count)).Copy
MyTable.Range('A1')
'以下内容是将新表改为汇总表，如果有汇总表存在，则弹出提示
On Error GoTo ErrorHandler
MyTable.Name = '汇总表'
ErrorHandler:
If Err.Number = 1004 Then
MsgBox
'汇总表已存在'
'删除生成的数据透视表
Application.DisplayAlerts = False
For Each sh
In Worksheets
If sh.Name Like 'Sheet*' Then
sh.Delete
Next
Application.DisplayAlerts = True
Else
'删除生成的数据透视表
Application.DisplayAlerts = False
For Each sh
In Worksheets
If sh.Name Like 'Sheet*' Then
sh.Delete
Next
Application.DisplayAlerts = True
End If
End Sub
