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

这是我的项目：

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

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

我遵循此build议完成数据透视表粘贴值/格式： 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 

有什么build议么？

Answer 1

这段代码

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

select工作表的最后一列，这就是为什么你不能粘贴超过一列的东西。 你需要修改findNextRow的逻辑。

编辑：

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

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

显然，Cells（）的默认ColumnIndex参数不是1，您需要明确地设置它。