将多张工作表复制到新工作簿，同时仅保留值和数据透视表

Question

我正在尝试创建一个宏，该宏将多个工作表的值（除第一个之外）从活动工作簿复制到一个新工作簿中，我已将路径放在 sheet1 的单元格 F21 中。

下面是使我能够为 sheet2 执行此操作的代码。但我似乎找不到如何调整它，以便它适用于第 2、3、4、5、6、7、8 和 9 页。

另一个需要注意的有趣的事情是 sheet8 包含数据透视表，将其复制到另一个工作表时似乎是一个问题。

你知道我该怎么做吗？ （顺便说一句，如果你知道怎么做，但是 sheet1 包含在新文件中，这不是什么大问题）

非常感谢。

Sub export()

Dim SourceBook As Workbook, DestBook As Workbook, SourceSheet As Worksheet, DestSheet As Worksheet

Dim SavePath As String, i As Integer

Application.ScreenUpdating = False

Set SourceBook = ThisWorkbook

SavePath = Sheets("Sheet1").Range("F21").Text
Set SourceSheet = SourceBook.Sheets("Sheet2")

Set DestBook = Workbooks.Add
Set DestSheet = DestBook.Worksheets.Add

Application.DisplayAlerts = False
For i = DestBook.Worksheets.Count To 2 Step -1
    DestBook.Worksheets(i).Delete
Next i
Application.DisplayAlerts = True

SourceSheet.Cells.Copy
With DestSheet.Range("A1")
    .PasteSpecial xlPasteValues
    .PasteSpecial xlPasteFormats 'Delete if you don't want formats copied
End With

DestSheet.Name = SourceSheet.Name
DestBook.Activate
With ActiveWindow
    .DisplayGridlines = False
    .DisplayWorkbookTabs = False
End With
SourceBook.Activate

Application.DisplayAlerts = False 'Delete if you want overwrite warning
DestBook.SaveAs Filename:=SavePath
Application.DisplayAlerts = True 'Delete if you delete other line

SavePath = DestBook.FullName
DestBook.Close 'Delete if you want to leave copy open
MsgBox ("A copy has been saved to " & SavePath)

End Sub

Answer 1

我强烈建议您研究以下主题。我提供了几个链接来帮助您入门。

• 向过程传递参数 (https://www.homeandlearn.org/passing_values_to_a_sub.html)
• 参数和参数 (https://stackoverflow.com/questions/156767/whats-the-difference-between-an-argument-and-a-parameter#:~:text=Generally%20speaking%2C%20the%20terms%20parameter,function%20when%20it%20is%20called.)
• 模块化编程 (https://en.wikipedia.org/wiki/Modular_programming)

下面的代码通过所有工作表传递参数和循环。此设置允许您通过更改DoExport 过程中的iSheetStart 和iSheetEnd 参数的值来复制任意数量的（连续）工作表。因为逻辑已被抽象并拆分为更模块化的形式，所以它足够通用，您可以一遍又一遍地使用相同的代码，而无需每次都重新编写代码。其中一些逻辑也可以进一步分解为更多的过程。

您还可以通过将您拥有"Delete if..." cmets 的所有情况更改为过程参数来进一步抽象代码。也可以制作SavePath、SourceBook、Destbook等参数。

我还鼓励您查看Worksheets.Copy 方法（https://docs.microsoft.com/en-us/office/vba/api/excel.worksheet.copy）。这可能比您目前正在做的更快，尽管我不相信有排除格式的选项。

您应该运行的过程是DoExport。所有其他过程都会被它调用。

Option Explicit
    
    
Sub DoExport()

    Export iStartSheet:=2, iEndSheet:=9
    
End Sub


Sub Export(iStartSheet As Integer, iEndSheet As Integer)

    Dim SourceBook      As Workbook:    Set SourceBook = ThisWorkbook
    Dim SavePath        As String:      SavePath = SourceBook.Sheets("Sheet1").Range("F21").Text
    Dim DestBook        As Workbook:    Set DestBook = Workbooks.Add
    Dim iSheetNum       As Integer
    
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    
    For iSheetNum = iStartSheet To iEndSheet
        CopySheet SourceBook, DestBook, iSheetNum
    Next iSheetNum
    
    DestBook.Activate
    With ActiveWindow
        .DisplayGridlines = False
        .DisplayWorkbookTabs = False
    End With
    
    DestBook.SaveAs Filename:=SavePath
    With Application
        .DisplayAlerts = False 'Delete if you want overwrite warning
        .DisplayAlerts = True 'Delete if you delete other line
    End With
    
    DestBook.Close 'Delete if you want to leave copy open
    MsgBox ("A copy has been saved to " & SavePath)

End Sub


Sub CopySheet(SourceBook As Workbook, ByRef DestBook As Workbook, iSheetNum As Integer)

    Dim SourceSheet     As Worksheet
    Dim DestSheet       As Worksheet
    
    With DestBook.Sheets
        Set DestSheet = IIf(.Count < iSheetNum, _
                            .Add(After:=DestBook.Sheets(.Count)), _
                            DestBook.Sheets(iSheetNum))
    End With
    
    Set SourceSheet = SourceBook.Sheets(iSheetNum)
    SourceSheet.Cells.Copy
    With DestSheet
        With .Range("A1")
            .PasteSpecial xlPasteValues
            .PasteSpecial xlPasteFormats 'Delete if you don't want formats copied
        End With
        .Name = SourceSheet.Name
    End With

End Sub