Question

我正在尝试从一个工作簿到新工作簿复制三张表（两张表是数据透视表，其中一张是这些支点的源数据）。

下面的代码将所需的工作表复制到新工作簿并保存（修改后的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

但是，当我打开新工作簿时，数据透视表中的数据源仍指向原始工作簿。我的同事解释说，这是因为纸张被逐一复制，而不是一组，并建议将纸张复制为范围。我如何将工作表复制为范围，还是更容易将数据源更改为新复制的工作表？

Answer 1

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

至于将新的枢轴指向新的源，您需要做的就是从数据透视源中删除外部引用。它的格式为[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

Answer 2

您可能希望“移动”（相当于切割的工作表）工作表而不是仅仅复制它们。复制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保存，所以我不认为这是一个问题 - 但就像一个FYI：切割不会影响你的原始副本，除非你保存它以后

Answer 3

我觉得最简单的选择就是改变枢轴上的数据源。不确定这是最干净的语法还是有快捷方式，但它对我有用。

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

复制的工作表的数据源

3 个答案: