Я хочу вставить сводную таблицу из листа два в другую рабочую книгу как диапазон, но, похоже, она не работает

Question

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.

Answer 1

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

Answer 2

Попробуйте изменить код ниже:

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

Кому:

   pt.TableRange1.Copy
   apws.Cells(1, 1).PasteSpecial xlPasteValues