时间戳

首页 > 解决方案 > 我想将第二张工作表中的数据透视表作为范围粘贴到另一个工作簿中，但它似乎不起作用

vba - 我想将第二张工作表中的数据透视表作为范围粘贴到另一个工作簿中，但它似乎不起作用

问题描述

Sub pivot()
Dim ws As Worksheet, pt As PivotTable, pf As PivotField, apwb As Workbook, apws As Worksheet, LastRow As Integer
Set apwb = Workbooks.Open("F:\My Documents - Disk C\Victor\VBA\Paste\Paste.xlsx")
Set apws = apwb.Worksheets("Sheet1")
For Each ws In ActiveWorkbook.Worksheets

    For Each pt In ws.PivotTables

        With pt
            .ColumnGrand = False
            .RowGrand = False
            .RowAxisLayout xlTabularRow
            .PivotFields("City").Orientation = xlHidden
            .PivotFields("Product").Orientation = xlRowField

        End With
        For Each pf In pt.PivotFields
            pf.Subtotals(1) = False
        Next pf


        pt.PivotSelect "", xlData, True
        Selection.Copy
        apws.Cells(1, 1).PasteSpecial xlPasteValues
    Next pt
Next ws
End Sub

该代码根本不会修改 Paste.xlsx 文件。我应该在我的代码中更改什么？我对VBA有一个中等的理解。

标签： vbaexcelpivot-table

解决方案

Set apwb = Workbooks.Open("C:\Users\Lee Li Fong\Desktop\Website\Book2.xlsx")
Set apws = apwb.Worksheets("Sheet6")
C = 1

For Each ws In ActiveWorkbook.Worksheets
    If ws.PivotTables.Count > 0 Then    'Only copy sheet have pivot table
        ws.PivotTables(1).TableRange1.Copy
        apws.Cells(1, C).PasteSpecial xlPasteValues
        Selection.EntireColumn.AutoFit
        C = C + 5   'next paste to other column
    End If
Next

推荐阅读