excel - 编辑 VBA 将多个工作表作为值粘贴到新工作簿中

Question

代码来自this forum是我用作起点的。我正在尝试修改它以复制多张纸并将它们全部粘贴为值，而不是仅粘贴一张纸。

我使用 worksheets(array(1,2,3)).copy 复制了多张工作表。我认为问题在于 With ActiveSheet.UsedRange 因为它只是将第一个工作表替换为值，并将其余工作表保留为公式。

我需要更改什么才能将所有工作表粘贴为值？

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.DisplayAlerts = False
    Worksheets(Array("Sheet 1","Sheet 2","Sheet 3").Copy
    With ActiveSheet.UsedRange
        .Value = .Value
    End With
    Set wbNew = ActiveWorkbook
    wbNew.SaveAs "L:\Performance Data\UK Sales\Sales (Latest).xlsx"
    wbNew.Close True
    Application.DisplayAlerts = True
End Sub

Answer 1

您需要循环浏览工作表:

Dim ws As Worksheet

For Each ws In ActiveWorkbook.Worksheets
    ws.UsedRange.Value = ws.UsedRange.Value
Next ws

因此，使用您的代码，您可以这样做:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim wbOld As Workbook, wbNew As Workbook
Dim ws As Worksheet, delWS As Worksheet
Dim i       As Long, lastRow As Long, lastCol As Long
Dim shts()  As Variant
Dim rng As Range

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set wbOld = ActiveWorkbook

shts() = Array("Sheet 1", "Sheet 2", "Sheet 3")
Set wbNew = Workbooks.Add
Set delWS = ActiveSheet
wbOld.Worksheets(Array("Sheet 1", "Sheet 2", "Sheet 3")).Copy wbNew.Worksheets(1)
delWS.Delete

For i = LBound(shts) To UBound(shts)
    With wbNew.Worksheets(shts(i))
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        Set rng = .Range(.Cells(1, 1), .Cells(lastRow, lastCol))
        rng.Value = rng.Value
    End With
Next i

wbNew.SaveAs "L:\Performance Data\UK Sales\Sales (Latest).xlsx"
wbNew.Close True

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

注意:我不确定您要将值粘贴到哪个工作簿中。如上所述，它是在复制的工作簿中执行此操作，而不是在原始工作簿中。