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

VBA复制粘贴值一次多个表格

1 个答案: