新しいブックに値として複数のシートを貼り付けるようにVBAを編集

Question

this forumのコードは、私が出発点として使用したものです。私は、複数のシートをコピーして、それらをすべて1つのシートではなく値として貼り付けるように修正しようとしています。

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 

注：私はわからないそのワークブック上記のように、これは元のコピーではなくコピーしたブックで行います。