1

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

下面的代码将所需的工作表复制到新工作簿并保存（修改后的原始工作表）：

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

但是，当我打开新工作簿时，数据透视表中的数据源仍指向原始工作簿。我的同事解释说，这是因为表格是一张一张地复制的，而不是一组复制的，并建议将表格复制为一个范围。我将如何将工作表复制为一个范围，或者将数据源更改为新复制的工作表是否更简单？

4

3 回答 3

2

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

至于将新轴点指向新源，您需要做的就是从 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-25T01:22:39.560 回答
1

您可能想要“移动”（相当于剪切的工作表）工作表，而不仅仅是复制它们。在 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-24T21:16:50.493 回答
0

我觉得最简单的选择是只更改枢轴上的数据源。不确定这是否是最简洁的语法或是否有快捷方式，但它对我有用。

' Change pivot table data source
ActiveWorkbook.Worksheets("pivot").PivotTables("PivotTable1").ChangePivotCache ActiveWorkbook. _
PivotCaches.Create(SourceType:=xlDatabase, SourceData:="stagePivotData", _
Version:=xlPivotTableVersion10)
于 2012-10-25T18:07:27.817 回答