编辑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 

注：我不知道这工作簿您想粘贴这些值。如上所示，它在COPIED工作簿中执行此操作，而不是原始操作。