excel - 仅将多个工作表中的值复制到新工作簿

Question

假设我有一个 workbook1.xlsm，其中包含多个工作表并充满各种公式。我想创建一个新的 workbook2.xlsx ，它看起来与 workbook1 完全一样，但所有单元格中都是值而不是公式。

我有这个宏来从 workbook1 复制一张工作表:

Sub nowe()

Dim Output As Workbook
Dim FileName As String

Set Output = Workbooks.Add
Application.DisplayAlerts = False

ThisWorkbook.Worksheets("Przestoje").Cells.Copy

Selection.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=True, Transpose:=False

Selection.PasteSpecial Paste:=xlPasteFormats

FileName = ThisWorkbook.Path & "\" & "worksheet2.xlsx"
Output.SaveAs FileName

End Sub

但问题是它只复制一个工作表，并且没有像 worksheet1 中那样命名它。我无法弄清楚。

另一个问题是 worksheet2 随后被打开。我不想这样做。

如何解决这些问题？

Answer 1

我会尽可能简单地做到这一点，而无需创建新的工作簿并将工作表复制到其中。

几个简单的步骤:考虑到此工作簿 >> 对于此工作簿中的每个工作表 >> 复制+粘贴工作表中使用范围的值 >> 另存为 xlsx 类型的新工作簿 >> 打开基础工作簿 >> 和最后关闭我们创建的一个。

代码很简单，如下所示:

Sub nowe_poprawione()

    Dim Output As Workbook
    Dim Current As String
    Dim FileName As String

    Set Output = ThisWorkbook
    Current = ThisWorkbook.FullName

    Application.DisplayAlerts = False

    Dim SH As Worksheet
    For Each SH In Output.Worksheets

        SH.UsedRange.Copy
        SH.UsedRange.PasteSpecial xlPasteValues, _
            Operation:=xlNone, SkipBlanks:=True, Transpose:=False

    Next

    FileName = ThisWorkbook.Path & "\" & "worksheet2.xlsx"
    Output.SaveAs FileName, XlFileFormat.xlOpenXMLWorkbook
    Workbooks.Open Current
    Output.Close
    Application.DisplayAlerts = True
End Sub