VBA一次复制粘贴多张表

我有一个macros，我用来复制工作表到一个新的工作簿，然后复制粘贴值工作表保存一个新的副本。 唯一的办法是我能够弄清楚如何做到这一点，是select，复制和粘贴每个单独的工作表，有没有一种方法来做更less的代码多张？

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文件中的所有工作表，但只能select那些（下面的代码允许你定义要复制的工作表的名字）。

我已经添加了对大多数行的评论，以帮助您了解代码中发生了什么。

---

 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