包含数据透视表的拆分和硬编码工作表

Question

我是使用 VBA 代码的新手。我有一个包含手动创建的表和数据透视表的工作簿。对于本书中的每个工作表，我想将数据硬编码到一个新的工作簿中，并将其保存为被硬编码的工作表的名称。我有下面的代码。它正在正确保存每个工作簿，但工作簿的内容不正确。每次都在我的原始工作簿中对第一个工作表的内容进行硬编码。我试图在代码末尾设置下一个 ActiveSheet，但它失败了。我有没有提到我不是程序员？请帮忙！

Sub Splitbook()

Dim path As String
Dim dt As String
path = CreateObject("WScript.Shell").specialfolders("Desktop") & "\SLF\ "
Call Shell("explorer.exe" & " " & path, vbNormalFocus)

Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets 
    ActiveSheet.UsedRange.Select
    Selection.Copy
    Workbooks.Add
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveWorkbook.SaveAs path & ws.Name, Excel.XlFileFormat.xlOpenXMLWorkbook
    ActiveWorkbook.Close SaveChanges:=False
Next ws
End Sub

Answer 1

您已经在工作簿的工作表中循环了代码，因此您不需要从 ActiveSheet 而是从 ws 工作表变量复制。

您也不需要使用Select 来复制数据。

Dim ws As Worksheet
Dim newBook As Workbook
For Each ws In ThisWorkbook.Worksheets
    ws.UsedRange.Copy
    Set newBook = Workbooks.Add
    With newBook.Worksheets(1).Range("A1")
        .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
    End With
    newBook.SaveAs Path & ws.Name, Excel.XlFileFormat.xlOpenXMLWorkbook
    newBook.Close SaveChanges:=False
Next ws