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

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

1 个答案: