将工作表（包含表格）从活动工作簿移动到打开的现有工作簿

我正在寻找一种方法来将活动工作簿（从中运行macros）中的所有工作表复制到另一个当前打开的工作簿。 活动工作簿具有带有表格的工作You cannot copy or move a group of sheets that contain a table如果通过Excel传统移动You cannot copy or move a group of sheets that contain a table错误You cannot copy or move a group of sheets that contain a table 。

我在论坛中find了以下代码：

 'Written by Trebor76 'Visit my website www.excelguru.net.au Dim strMyArray() As String 'Declares a dynamic array variable Dim intArrayCount As Integer Dim wstMySheet As Worksheet intArrayCount = 0 'Initialise array counter Application.ScreenUpdating = False For Each wstMySheet In ThisWorkbook.Worksheets If wstMySheet.Name <> "Customer" And wstMySheet.Name <> "Billing" Then intArrayCount = intArrayCount + 1 ReDim Preserve strMyArray(1 To intArrayCount) 'Copy elements from the existing array to the new array strMyArray(intArrayCount) = wstMySheet.Name End If Next ThisWorkbook.Worksheets(strMyArray).Copy Erase strMyArray() 'Deletes the varible contents to free some memory Application.ScreenUpdating = True 

唯一的一点是，它将复制的工作表移动到一个全新的工作簿中。 我尝试使用Before:=Workbooks("Destination.xlm").Sheets(Sheetname) ThisWorkbook.Worksheets(strMyArray).Copy但它不起作用。

我怎样才能修改这个macros来将表单移动到一个打开的现有工作簿而不是一个全新的工作簿？

Answer 1

尝试下面的代码。 请在您的目标工作簿中编辑Book2.xlsx for for循环

 Sub test() Dim i as Long Dim strMyArray() As String 'Declares a dynamic array variable Dim intArrayCount As Integer Dim wstMySheet As Worksheet intArrayCount = 0 'Initialise array counter Application.ScreenUpdating = False For Each wstMySheet In ThisWorkbook.Worksheets If wstMySheet.Name <> "Customer" And wstMySheet.Name <> "Billing" Then intArrayCount = intArrayCount + 1 ReDim Preserve strMyArray(1 To intArrayCount) 'Copy elements from the existing array to the new array strMyArray(intArrayCount) = wstMySheet.Name End If Next ' N ewly E dited For i = 1 To UBound(strMyArray) ThisWorkbook.Worksheets(strMyArray(i)).Copy After:=Workbooks("Book2.xlsx").Sheets(Sheets.Count) Next i ' N ewly E dited Erase strMyArray() 'Deletes the varible contents to free some memory Application.ScreenUpdating = True End Sub 

Answer 2

根据MS文档使用.Copy方法的多个工作表的数组select将导致工作表被放入一个新的工作簿。

您将需要build立一个循环来传输你的工作表。 下面是一个简单的例子…

 Sub myTransfer() Dim fromWB As Workbook Dim toWB As Workbook Dim mySht As Worksheet Set fromWB = Workbooks("Book1") Set toWB = Workbooks("Book2") For Each mySht In fromWB.Worksheets mySht.Copy after:=toWB.Worksheets("Sheet1") Next mySht End Sub