Question

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

我有这个宏从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之后正在打开。我不想这样做。

我该如何解决这些问题？

Answer 1

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

几个简单的步骤：taking into consideration thisworkbook >> for each worksheet within thisworkbook >> copy+paste values of used range within worksheet >> save as new workbook as xlsx type >> open back base workbook >> and finally close one we created.

代码很简单，如下所示：

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

Answer 2

这样的东西可以在添加工作簿后循环并复制所有工作表：

dim i as integer
For i = 1 To ThisWorkbook.Worksheets.Count

    ThisWorkbook.Worksheets(i).Activate
    ThisWorkbook.Worksheets(i).Select
    Cells.Copy

    Output.Activate

    Dim newSheet As Worksheet
    Set newSheet = Output.Worksheets.Add()
    newSheet.Name = ThisWorkbook.Worksheets(i).Name

    newSheet.Select
    Cells.Select

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

Next

请注意，这不会处理删除在创建工作簿时自动创建的默认工作表。

此外，只要你打电话给worksheet2，实际上就会被打开（虽然没有命名为SaveAs）：

 Set Output = Workbooks.Add

保存后关闭它：

 Output.Close

Answer 3

这样的东西可以在添加工作簿之后循环并复制所有工作表 - 它建立在mr.Reband的答案上，但有一些铃声和口哨声。除了其他东西，它将在第三个工作簿（或加载项等）中工作，它删除创建的默认工作表，它确保工作表的顺序与原始的相同，等等：< / p>

Option Explicit

Sub copyAll()

Dim Output As Workbook, Source As Workbook
Dim sh As Worksheet
Dim FileName As String
Dim firstCell

Application.ScreenUpdating = False
Set Source = ActiveWorkbook

Set Output = Workbooks.Add
Application.DisplayAlerts = False

Dim i As Integer

For Each sh In Source.Worksheets

    Dim newSheet As Worksheet

    ' select all used cells in the source sheet:
    sh.Activate
    sh.UsedRange.Select
    Application.CutCopyMode = False
    Selection.Copy

    ' create new destination sheet:
    Set newSheet = Output.Worksheets.Add(after:=Output.Worksheets(Output.Worksheets.Count))
    newSheet.Name = sh.Name

    ' make sure the destination sheet is selected with the right cell:
    newSheet.Activate
    firstCell = sh.UsedRange.Cells(1, 1).Address
    newSheet.Range(firstCell).Select

    ' paste the values:
    Range(firstCell).PasteSpecial Paste:=xlPasteValues, _
    Operation:=xlNone, SkipBlanks:=True, Transpose:=False

Next

' delete the sheets that were originally there
While Output.Sheets.Count > Source.Worksheets.Count
  Output.Sheets(1).Delete
Wend
FileName = ThisWorkbook.Path & "\" & "worksheet2.xlsx"
Output.SaveAs FileName
Output.Close
Application.ScreenUpdating = True

End Sub

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

3 个答案: