將多個特定工作表復制到新工作簿

Question

我正在使用一些遺留代碼將一個特定的工作表（ Daily Summary ）復制到一個新的工作簿，然后用它們的實際值替換所有公式。 這適用於一張工作表，但是一旦我嘗試為具有工作表名稱（ "Daily Summary","Daily Report" ）的指定工作表數組設置一個foreach ，代碼就會中斷。 復制多張工作表是否有任何特定語法？

我確實看過這篇 SO 文章，但無法在 Excel 上為 MAC 運行此代碼，遺憾的是這是必需的。

Excel VBA 相當新，感謝有關此主題的任何指導。 謝謝你。

'Copy the sheet to a new workbook
Sheets("Daily Summary").Copy Before:=Sheets(1)

With ActiveSheet
    .Cells.Copy
    .Cells.PasteSpecial xlPasteValues
End With
Application.CutCopyMode = False

pctCompl = 10

ActiveSheet.Copy
Set Destwb = ActiveWorkbook



'Determine the Excel version and file extension/format
With Destwb
    If Val(Application.Version) < 12 Then
        'You use Excel 2000-2003
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
        'You use Excel 2007-2010, we exit the sub when your answer is
        'NO in the security dialog that you only see  when you copy
        'an sheet from a xlsm file with macro's disabled.
        If Sourcewb.Name = .Name Then
            With Application
                .ScreenUpdating = True
                .EnableEvents = True
            End With
            MsgBox "Your answer is NO in the security dialog"
            Exit Sub
        Else
            Select Case Sourcewb.FileFormat
            Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
            Case 52:
                If .HasVBProject Then
                    FileExtStr = ".xlsm": FileFormatNum = 52
                    'FileExtStr = ".pdf": FileFormatNum = 17
                Else
                    FileExtStr = ".xlsx": FileFormatNum = 51
                End If
            Case 56: FileExtStr = ".xls": FileFormatNum = 56
            Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
            End Select
        End If
    End If
End With

pctCompl = 30

'Change all cells in the worksheet to values if you want
'With Destwb.Sheets(1).Range("A1:I50")
'    .Select
'    .Copy
'    .PasteSpecial xlPasteValues
'End With
'Application.CutCopyMode = False

Answer 1

導出多個工作表

Sub ExportWorksheets()

    ' Source
    
    Dim sWorkSheetNames() As Variant
    sWorkSheetNames = Array("Daily Summary", "Daily Report")
    
    ' Reference the source workbook ('swb').
    Dim swb As Workbook: Set swb = ThisWorkbook ' workbook containing this code

    ' Copy the worksheets to a new workbook.
    swb.Worksheets(sWorkSheetNames).Copy
    
    ' Destination
    
    ' Reference this new workbook, the destination workbook ('dwb').
    Dim dwb As Workbook: Set dwb = Workbooks(Workbooks.Count)
    
    Dim dws As Worksheet
    Dim drg As Range
    
    ' Convert formulas to values.
    For Each dws In dwb.Worksheets
        Set drg = dws.UsedRange
        drg.Value = drg.Value
    Next dws

    ' Continue to save the destination workbook...

    dwb.Saved = True ' just for easy closing while testing this code

End Sub