VBA一次復制粘貼值多個表

Question

我有一個宏，可用於將工作表數組復制到新工作簿中，然后復制粘貼值以保存工作表的新副本。 我唯一能弄清楚如何選擇，復制和粘貼每張紙的唯一方法，有沒有辦法用更少的代碼制作多張紙？

Set Name = Sheets("TOTAL STO").Range("file.name")
Sheets(Array("TOTAL STO", "TOTAL STO - OLD LOGIC", "OWN BUY STO", "CONSIGNMENT STO")).Select
Sheets(Array("TOTAL STO", "TOTAL STO - OLD LOGIC", "OWN BUY STO", "CONSIGNMENT STO")).Copy

Set NewWB = ActiveWorkbook
NewWB.Sheets("TOTAL STO").Cells.Copy
NewWB.Sheets("TOTAL STO").Range("A1").PasteSpecial Paste:=xlValues
NewWB.Sheets("TOTAL STO - OLD LOGIC").Cells.Copy
NewWB.Sheets("TOTAL STO - OLD LOGIC").Range("A1").PasteSpecial Paste:=xlValues
NewWB.Sheets("OWN BUY STO").Cells.Copy
NewWB.Sheets("OWN BUY STO").Range("A1").PasteSpecial Paste:=xlValues
NewWB.Sheets("CONSIGNMENT STO").Cells.Copy
NewWB.Sheets("CONSIGNMENT STO").Range("A1").PasteSpecial Paste:=xlValues

Answer 1

這是實現此任務的代碼。 我假設您不想復制原始Excel文件中的所有工作表，而只希望復制選定的工作表（下面的代碼允許您定義要復制的工作表的名稱）。

我已經在大多數行中添加了注釋，以幫助您了解代碼中正在發生的事情。

---

Public Sub copySheets()
    Dim wkb As Excel.Workbook
    Dim newWkb As Excel.Workbook
    Dim wks As Excel.Worksheet
    Dim newWks As Excel.Worksheet
    Dim sheets As Variant
    Dim varName As Variant
    '------------------------------------------------------------


    'Define the names of worksheets to be copied.
    sheets = VBA.Array("TOTAL STO", "TOTAL STO - OLD LOGIC", "OWN BUY STO", "CONSIGNMENT STO")


    'Create reference to the current Excel workbook and to the destination workbook.
    Set wkb = Excel.ThisWorkbook
    Set newWkb = Excel.Workbooks.Add


    For Each varName In sheets

        'Clear reference to the [wks] variable.
        Set wks = Nothing

        'Check if there is a worksheet with such name.
        On Error Resume Next
        Set wks = wkb.Worksheets(VBA.CStr(varName))
        On Error GoTo 0


        'If worksheet with such name is not found, those instructions are skipped.
        If Not wks Is Nothing Then

            'Copy this worksheet to a new workbook.
            Call wks.Copy(newWkb.Worksheets(1))

            'Get the reference to the copy of this worksheet and paste
            'all its content as values.
            Set newWks = newWkb.Worksheets(wks.Name)
            With newWks
                Call .Cells.Copy
                Call .Range("A1").PasteSpecial(Paste:=xlValues)
            End With

        End If

    Next varName

End Sub