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