复制工作表的数据源

我试图从一个工作簿复制三张（两张是数据透视表，其中一张是来自这些枢轴的源数据），并将其从一个工作簿复制到新的工作簿。复制工作表的数据源

下面副本的代码所需的片材的新的工作簿，并保存它（改性original）：

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

然而，当我打开新的工作簿时，在枢轴表中的数据源仍然指向原始工作簿。我的同事解释说，这是因为表单被逐一复制，而不是一组，并建议复制表单作为范围。我怎样才能将这些表单复制为一个范围，或者将数据源更改为新的复制表单更简单？

来源

2012-10-24 Kermit

您需要将数据透视表的源数据更改为新的工作簿。仅仅因为您一次复制所有工作表，不会让数据透视表知道您想将源更改为复制的工作表。 –

我觉得最简单的选择就是改变数据源的关键点。不知道这是否是最干净的语法，或者是否有快捷方式，但它适用于我。

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

来源

2012-10-25 18:07:27 Kermit

这当然是另一个不错的选择。 – Stepan1010

@NJK，你的答案包括你没有包含在原始问题中的信息 - 在问题中没有任何地方提到在任何工作簿中称为“stagePivotData”的范围。 – ExactaBox

@ExactaBox那是我的错。当时它似乎好像指向表单或范围对我来说是一样的。你能否详细说明这可能是有利的？ – Kermit

您可能要“移动”（工作表等效于剪切）工作表，而不是只复制它们。在Excel中复制任何内容都不会更改对复制数据的新位置的任何引用（它仍使用原始数据）。但是将数据从一个地方切换到另一个地方会改变对该数据新位置的引用。所以我会做这样的事情：

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

这是记录 - 显然你会想要使用适合您的具体情况的.Move命令。

或者，如果你这样做是对的细胞，你会想用：

ws.Cells.Cut

它看起来像你关闭原始工作簿，而不在ActiveWorkbook.Close SaveChanges:=False保存，所以我不认为这是一个问题 - 但只是一个参考：切割不会影响您的原始副本，除非您将其保存在其后。

来源

2012-10-24 21:16:50 Stepan1010

但是，如果您移动工作表，那么它们不再位于您的原始工作簿中，这会挫败“导出”功能的用途。 –

看起来他正在关闭原始工作簿而不在ActiveWorkbook上保存任何内容。关闭SaveChanges：= False - 但无论如何，只要他不从原始工作簿中删除原始工作簿，它就不会影响原始工作簿数据。他总是可以在宏前保存，然后重新打开并返回到保存状态。 – Stepan1010

然后这可能是要走的路，@njk –

通过复制整个工作表而不是单元格，可以简化创建新工作簿部件的过程。

只要将新的支点指向新的源，您需要做的就是从PivotSource中移除外部引用。它的格式为[oldworkbook]sourcedata!A1:Z100，所以您只需要截断括号内的部分。（这不是一个通用的解决方案，但在这种情况下，我们同时复制数据源选项卡和数据透视表，因此我们知道新工作簿将具有相同名称，相同大小，相同范围等的数据选项卡作为原始的工作簿）

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

来源

2012-10-25 01:22:39 ExactaBox

复制工作表的数据源

回答

相关问题