复制工作表的数据源

我试图从一个工作簿复制三张(两张是数据透视表,一个是这些枢纽的源数据)到一个新的工作簿。

下面的代码将所需的图纸复制到新的工作簿并保存(修改原始 ):

Sub ExportFile() Dim NewName As String Dim nm As Name Dim ws As Worksheet With Application .ScreenUpdating = False On Error GoTo ErrCatcher ' Array of sheets to copy Sheets(Array("sourcedata", "pivot", "pivot2")).Copy On Error GoTo 0 For Each ws In ActiveWorkbook.Worksheets ws.Cells.Copy ' Paste sheets ws.[A1].PasteSpecial ' Remove external links, hyperlinks and hard-code formulas ws.Cells.Hyperlinks.Delete Application.CutCopyMode = False ' Select A1 on sheet Cells(1, 1).Select ws.Activate Next ws Cells(1, 1).Select ' Save it in the same directory as original and close ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "\export.xls" ActiveWorkbook.Close SaveChanges:=False .ScreenUpdating = True End With Exit Sub ErrCatcher: MsgBox "Specified sheets do not exist within this workbook" End Sub 

但是,当我打开新的工作簿时,数据透视表中的数据源仍然指向原始工作簿。 我的同事解释说,这是因为表单被逐一复制,而不是一组,并build议将表单作为范围复制。 我将如何去复制作为一个范围的工作表,还是更简单的方法来将数据源更改为新复制的工作表?

你可能要“移动”(工作表等同于剪切)的工作表,而不是复制它们。 在excel中复制任何内容不会改变对复制数据新位置的引用(它仍然使用原始数据)。 但是将数据从一个地方切换到另一个地方将改变对该数据的新位置的引用。 所以我会做这样的事情:

 Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select Sheets("Sheet3").Activate Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Move Before:=Workbooks("Book2").Sheets(2) 

这是logging – 显然你会想适当地使用.Move命令为您的具体情况。

或者如果你正在为你想要使用的单元格做这个:

 ws.Cells.Cut 

看起来您正在closures原始工作簿而不保存在ActiveWorkbook.Close SaveChanges:=False所以我不认为这是一个问题 – 但只是作为一个参考:切割不会影响您的原始副本,除非您保存它向后。

通过复制整个工作表而不是单元格,可以简化创build新的工作簿部分。

至于指向新的来源的新枢纽,所有你需要做的就是从PivotSource中删除外部引用。 它的格式是[oldworkbook]sourcedata!A1:Z100所以你只需要截断括号内的部分。 (这不是一个通用的解决scheme,但在这种情况下,我们同时复制数据源选项卡和数据透视表,所以我们知道新的工作簿将具有相同名称,相同大小,相同范围等的数据选项卡作为原始的工作簿)

 Sub CopyPivotsAndData() Dim wb As Excel.Workbook, wbNew As Excel.Workbook Dim ws As Excel.Worksheet Dim pt As Excel.PivotTable Dim s As String Dim r As Integer Set wb = ThisWorkbook wb.Worksheets(Array("sourcedata", "pivot", "pivot2")).Copy Set wbNew = ActiveWorkbook Set ws = wbNew.Worksheets("pivot") Set pt = ws.PivotTables(1) s = pt.SourceData r = InStr(s, "]") pt.SourceData = Mid(s, r + 1) 'repeat for pivot2, or loop if you have many worksheets wbNew.SaveAs "newworkbookname.xlsx" 'close or clean up as necessary End Sub 

我觉得最简单的select就是改变主要数据源。 不知道这是最干净的语法,还是有一个快捷方式,但它适用于我。

 ' Change pivot table data source ActiveWorkbook.Worksheets("pivot").PivotTables("PivotTable1").ChangePivotCache ActiveWorkbook. _ PivotCaches.Create(SourceType:=xlDatabase, SourceData:="stagePivotData", _ Version:=xlPivotTableVersion10)