Question

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

我在论坛中找到了以下代码：

'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，但它无效。

如何修改此宏以将工作表移动到打开的现有工作簿而不是全新的工作簿？

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 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

Answer 2

根据MS documentation使用.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

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

2 个答案: