Excel-在多张图纸上复制数据透视表并粘贴为值（保留格式）

这是我的项目：

我从一个中心Excel文件中创建了一个项目定价和数据透视表。我确实“显示筛选页面”为特定字段中的每个唯一条目创建了不同的工作表（创建的工作表超过100个）。我将所有生成的数据透视表工作表移动到它们自己的工作簿（标题为“数据透视表结果”）

---

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

我遵循以下建议完成数据透视表的粘贴值/格式：

以下是我当前的代码：

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

有什么建议吗？

这段代码

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

选择工作表的最后一列，这就是为什么不能粘贴任何超过一列宽的内容。您需要修改查找

NextRow

的逻辑

编辑：

这个小小的改变可以做到：

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

---

显然，Cells（）的默认

ColumnIndex

参数不是1，您需要显式设置它。

我要做的是自动复制数据透视表数据，然后将其作为值粘贴到数据透视表下面的下一个可用空行中。然后再次粘贴相同的数据透视表以保留书本中所有工作表的格式。我的VBA代码为我提供了多个区域，不确定我在哪里出错。当我运行时。我收到“运行时错误1004”“我们无法粘贴，因为复制区域和粘贴区域的大小不一样”。很高兴能提供帮助！请通过接受此答案来结束此问题（单击“我的解决方案”旁边的绿色勾号图标）。