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

我正在寻找一种方法，将活动工作簿（从中运行宏）中的所有工作表复制到另一个当前打开的工作簿。活动工作簿中的工作表带有导致

错误的表格。如果您按照惯例通过excel移动包含表的工作表组，则无法复制或移动该工作表组

我在论坛中发现了以下代码：

'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

”由Trebor76编写
'访问我的网站www.excelguru.net.au
Dim strMyArray（）作为字符串“声明了一个动态数组变量
Dim intArrayCount为整数
将工作表设置为工作表
intArrayCount=0'初始化阵列计数器
Application.ScreenUpdating=False
对于此工作簿中的每个wstMySheet。工作表
如果wstMySheet.Name为“客户”且wstMySheet.Name为“账单”，则
intArrayCount=intArrayCount+1
ReDim Preserve strMyArray（1到intArrayCount）'将元素从现有阵列复制到新阵列
strMyArray（intArrayCount）=wstMySheet.Name
如果结束
下一个
此工作簿。工作表（strMyArray）。复制
Erase strMyArray（）'删除可变内容以释放一些内存
Application.ScreenUpdating=True

唯一的问题是，它将复制的工作表移动到一个全新的工作簿中。我尝试在
此工作簿之后使用
之前：=工作簿（“Destination.xlm”）.Sheets（Sheetname）
。工作表（strMyArray）。复制
，但不起作用

如何修改此宏以将工作表移动到打开的现有工作簿而不是全新的工作簿中？
尝试以下代码。请使用目标工作簿在for循环中编辑Book2.xlsx

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 e w l y    E d i t e d
    For i = 1 To UBound(strMyArray)
        ThisWorkbook.Worksheets(strMyArray(i)).Copy After:=Workbooks("Book2.xlsx").Sheets(Sheets.Count)
    Next i
    ' N e w l y    E d i t e d
    Erase strMyArray() 'Deletes the varible contents to free some memory
    Application.ScreenUpdating = True
End Sub

子测试（）
我想我会坚持多久
Dim strMyArray（）作为字符串“声明了一个动态数组变量
Dim intArrayCount为整数
将工作表设置为工作表
intArrayCount=0'初始化阵列计数器
Application.ScreenUpdating=False
对于此工作簿中的每个wstMySheet。工作表
如果wstMySheet.Name为“客户”且wstMySheet.Name为“账单”，则
intArrayCount=intArrayCount+1
ReDim Preserve strMyArray（1到intArrayCount）'将元素从现有阵列复制到新阵列
strMyArray（intArrayCount）=wstMySheet.Name
如果结束
下一个
“是的
对于i=1到UBound（strMyArray）
ThisWorkbook.Worksheets（strMyArray（i））.Copy After:=工作簿（“Book2.xlsx”）.Sheets（Sheets.Count）
接下来我
“是的
Erase strMyArray（）'删除可变内容以释放一些内存
Application.ScreenUpdating=True
端接头
根据为
使用多个工作表的数组选择。Copy
方法将导致工作表放入新工作簿中

您需要构建一个循环来传输图纸。下面是一个简单的例子

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

如果要移动图纸，请在复制后删除中的图纸loop@mindblues，根据上述代码，它将省略两页（客户和账单）。谢谢，伙计，非常感谢。