简体   繁体   中英

VBA Copy Paste Values Multiple Sheets at once

I've got a macro that I use to copy an array of sheets in to a new workbook, and then copy paste values the sheets to save a new copy. THe only way I was able to figure out how to do it was to select, copy and paste each individual sheet, is there a way to do multiple sheets with less code?

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

Here is the code to achieve this task. I have assumed that you don't want to copy all the worksheets from the original Excel file, but only selected ones (the code below allows you to define the names of worksheets to be copied).

I have added comments to most of the lines to help you understand what is going on in the code.


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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM