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

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

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

1 个答案: