首页 文章

Excel - 在多个工作表上复制数据透视表并粘贴为值（保留格式）

提问于
浏览 次
1

这是我的项目：

我从项目定价和数据的中央Excel文件创建了一个数据透视表 . 我做了“显示过滤页面”，为特定字段中的每个唯一条目创建不同的工作表（创建超过100个工作表） . 我将所有生成的数据透视表移动到他们自己的工作簿（ Headers 为PivotTableResults） .

我想要做的是自动复制数据透视表数据，然后将其粘贴到数据透视表下方的下一个可用空白行中 . 然后再次粘贴相同的数据透视表以保留格式，适用于本书中的所有工作表 .

我按照这个建议来完成数据透视表粘贴值/格式：http://spreadsheetpage.com/index.php/tip/unlinking_a_pivot_table_from_its_source_data/

这是我目前的代码：

Application.ScreenUpdating = False

Dim ws As Worksheet
    Dim pt As PivotTable
    Set pt = ActiveSheet.PivotTables(1)

For Each ws In ActiveWorkbook.Worksheets
    Dim NextRow As Range
    Set NextRow = ws.Cells(Cells.Rows.Count).End(xlUp).Offset(1)
    For Each pt In ws.PivotTables
        'ws.PivotTables("pt").PivotSelect "", xlDataAndLabel, True
        pt.TableRange2.Copy
        Set CurrentRow = NextRow
        CurrentRow.Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Application.CutCopyMode = False
        CurrentRow.Select
        Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Next pt

Next ws
End Sub

有什么建议？

excel vba pivot-table

1 回答

  • 2

    这段代码

    Set NextRow = ws.Cells(Cells.Rows.Count).End(xlUp).Offset(1)

    选择工作表的最后一列，即's why you cannot paste anything that'多个列宽 . 您需要修改查找 NextRow 背后的逻辑 .

    编辑：

    这个小改动将做到这一点：

    Set NextRow = ws.Cells(Cells.Rows.Count, 1).End(xlUp).Offset(1)

    显然，Cells（）的默认 ColumnIndex 参数不是1，您需要显式设置它 .

    回复于

相关问题