复制数据透视表并编辑

时间:2018-01-21 11:15:05

标签: vba excel-vba excel

我正在创建然后复制数据透视表并尝试在第二个数据透视图中插入pagefieled但只编辑第一个数据透视图而不是第二个数据透视表

请建议我错在哪里

下面是我写的代码

Sub CreatingPivotTable()
    Dim DataRange As String
    Dim DestiRange As String
    DataRange = ActiveSheet.name & "!" & Selection.Address(, , xlR1C1)
    Worksheets.Add after:=Worksheets(ActiveSheet.name)
    ActiveSheet.name = "Pivot Table"
    Set PT = ActiveSheet
    Range("a3").Select
    DestiRange = "'" & ActiveSheet.name & "'" & "!" & ActiveCell.Address(, , xlR1C1)
    Worksheets("Data Set2").Select
    ActiveSheet.PivotTableWizard xlDatabase, _
        SourceData:=DataRange, _
        TableDestination:=DestiRange
    Set PvtTbl = ActiveSheet.PivotTables(1)
    With PvtTbl
        With .PivotFields("Region")
            .Orientation = xlRowField
            .Position = 1
        End With
        With .PivotFields("Department")
            .Orientation = xlRowField
            .Position = 2
        End With
         .AddDataField ActiveSheet.PivotTables(1).PivotFields("Sales"), "Sum of Sales", xlSum
         .PivotFields("Sales").NumberFormat = "#,##.00000"
    End With
    With PvtTbl
     For Each pvtFld In .PivotFields
     pvtFld.Subtotals(1) = True
     pvtFld.Subtotals(1) = False
    Next pvtFld
    End With
    With PvtTbl
        .TableStyle2 = "PivotStyleMedium17"
        .PivotSelect "", xlDataAndLabel
    Selection.Copy
    Selection.EntireColumn.AutoFit
    End With
    Range("f3").PasteSpecial
    Set PvtTbl = Nothing
    Set PvtTb2 = ActiveSheet.PivotTables(2)
    With PvtTb2
       With .PivotFields("Employee Name")
            .Orientation = xlPageField
       End With
    End With
    End Sub

2 个答案:

答案 0 :(得分:0)

如果要复制数据透视表,请使用以下代码。

With PvtTbl
        .TableStyle2 = "PivotStyleMedium17"
        .TableRange1.Select
End With

.PivotSelect仅选择数据透视表的指定部分。

答案 1 :(得分:0)

我刚刚崩溃了答案

刚刚命名了新的数据透视表,而不是通过它的索引编号来调用它,现在我可以编辑新的数据透视表

 Sub CreatingPivotTable()
Dim DataRange As String
Dim DestiRange As String
Dim Inputsheet As Object, PT As Object
Set Inputsheet = ActiveSheet
DataRange = ActiveSheet.name & "!" & Selection.Address(, , xlR1C1)
Worksheets.Add after:=Worksheets(ActiveSheet.name)
ActiveSheet.name = "Pivot Table"
Set PT = ActiveSheet
Range("a3").Select
DestiRange = "'" & ActiveSheet.name & "'" & "!" & ActiveCell.Address(, , xlR1C1)
Worksheets("Data Set2").Select
ActiveSheet.PivotTableWizard xlDatabase, _
    SourceData:=DataRange, _
    TableDestination:=DestiRange
Set PvtTbl = ActiveSheet.PivotTables(1)
With PvtTbl
    With .PivotFields("Region")
        .Orientation = xlRowField
        .Position = 1
    End With
    With .PivotFields("Department")
        .Orientation = xlRowField
        .Position = 2
    End With
     .AddDataField ActiveSheet.PivotTables(1).PivotFields("Sales"), "Sum of Sales", xlSum
     .PivotFields("Sales").NumberFormat = "#,##.00000"
End With
With PvtTbl
 For Each pvtFld In .PivotFields
 pvtFld.Subtotals(1) = True
 pvtFld.Subtotals(1) = False
Next pvtFld
End With
With PvtTbl
    .TableStyle2 = "PivotStyleMedium17"
End With

Set PvtTbl = Nothing

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Second Pivot
Inputsheet.Select
DataRange = ActiveSheet.name & "!" & Selection.Address(, , xlR1C1)
PT.Select
Range("f3").Select
DestiRange = "'" & ActiveSheet.name & "'" & "!" & ActiveCell.Address(, , xlR1C1)
Inputsheet.Select
ActiveSheet.PivotTableWizard xlDatabase, _
    SourceData:=DataRange, _
    TableDestination:=DestiRange, TableName:="New Pivot Man"
Set PvtTb2 = ActiveSheet.PivotTables("New Pivot Man")
With PvtTb2
    With .PivotFields("Region")
        .Orientation = xlRowField
        .Position = 1
    End With
    With .PivotFields("Department")
        .Orientation = xlRowField
        .Position = 2
    End With
    With .PivotFields("Employee Name")
        .Orientation = xlPageField
        .Position = 1
    End With
     .AddDataField ActiveSheet.PivotTables(2).PivotFields("Sales"), "Sum of Sales", xlSum
     .PivotFields("Sales").NumberFormat = "#,##.00000"
End With
With PvtTb2
 For Each pvtFld In .PivotFields
 pvtFld.Subtotals(1) = True
 pvtFld.Subtotals(1) = False
Next pvtFld
End With
With PvtTb2
    .TableStyle2 = "PivotStyleMedium17"
End With
End Sub