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

从这个论坛的代码是我作为一个起点。 我试图修改它来复制多个工作表，并将其全部粘贴为值，而不是只有一个工作表。

我使用worksheets(array(1,2,3)).copy复制了多个worksheets(array(1,2,3)).copy 。 我认为问题是With ActiveSheet.UsedRange因为它只是将第一个工作表replace为值，而剩下的工作表作为公式。

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

 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工作簿中执行此操作，而不是原始操作。