vba 复制工作表的数据源
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/13056625/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Data source for copied worksheets
提问by Kermit
I'm attempting to copy three sheets (two sheets are pivot tables, one is the source data for those pivots) from one workbook to a new workbook.
我试图将三张工作表（两张工作表是数据透视表，一张是这些数据透视表的源数据）从一个工作簿复制到一个新工作簿。
The code below copies the desired sheets to the new workbook and saves it (modified 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
However, when I open the new workbook, the data source in the pivot tables still point to the original workbook. My colleague explained that this is because the sheets are being copied one by one, rather in a group and suggested to copy the sheets as a range. How would I go about copying the sheets as a range or would it be easier way to change the data source to the new copied sheets?
但是，当我打开新工作簿时，数据透视表中的数据源仍指向原始工作簿。我的同事解释说，这是因为工作表是一张一张复印的，而不是成组复印，并建议将工作表复印为一个范围。我将如何将工作表复制为一个范围，或者将数据源更改为新复制的工作表是否更简单？
采纳答案by Kermit
I felt that the easiest option was to just change the data source on the pivots. Not sure if this is the cleanest syntax or if there is a shortcut, but it works for me.
我觉得最简单的选择是更改枢轴上的数据源。不确定这是否是最干净的语法或者是否有快捷方式，但它对我有用。
' Change pivot table data source
ActiveWorkbook.Worksheets("pivot").PivotTables("PivotTable1").ChangePivotCache ActiveWorkbook. _
PivotCaches.Create(SourceType:=xlDatabase, SourceData:="stagePivotData", _
Version:=xlPivotTableVersion10)
回答by ExactaBox
You can simplify the creating a new workbook part by copying the entire worksheets, rather than the cells.
您可以通过复制整个工作表而不是单元格来简化创建新工作簿部件的过程。
As far as pointing the new pivots to the new source, all you need to do is remove the external reference from the PivotSource. It's in the format [oldworkbook]sourcedata!A1:Z100so you just need to truncate the part within the brackets. (This isn't a universal solution, but in this case we're copying the data source tab and the pivot tabs simultaneously, so we know the new workbook will have a data tab with the same name, same size, same range, etc as the original workbook)
至于将新枢轴指向新源，您需要做的就是从 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
回答by Stepan1010
You're probably going to want to "move"(the worksheet equivalent of cut) the worksheets instead of just copying them. Copying anything in excel doesn't change any references to the new location of the copied data(it still uses the original data). But cutting data from one place to another will change any references to the new location of that data. So I would do something like this:
您可能想要“移动”（相当于剪切的工作表）工作表，而不仅仅是复制它们。在 excel 中复制任何内容都不会更改对复制数据的新位置的任何引用（它仍然使用原始数据）。但是将数据从一个地方切割到另一个地方会改变对该数据新位置的任何引用。所以我会做这样的事情：
Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select
Sheets("Sheet3").Activate
Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Move Before:=Workbooks("Book2").Sheets(2)
This was recorded - obviously you would want to use the .Move command appropriately for your specific situation.
这已被记录 - 显然您希望根据您的特定情况适当地使用 .Move 命令。
Or if you are doing this for cells you would want to use:
或者，如果您正在为您想要使用的单元格执行此操作：
ws.Cells.Cut
It looks like you are closing the original workbook without saving at ActiveWorkbook.Close SaveChanges:=Falseso i don't think this is an issue - but just as an FYI: cutting won't affect your original copy unless you save it aftwerwards.
看起来您正在关闭原始工作簿而不保存，ActiveWorkbook.Close SaveChanges:=False所以我认为这不是问题 - 但仅供参考：除非您将其保存在后面，否则剪切不会影响您的原始副本。
