简体   繁体   中英

Moving sheets (with tables) from an active workbook to an open, existing workbook

I'm looking for a way to copy all the sheets within an active workbook (from which the macro is run) to another currently open workbook. The active workbook has sheets with tables leading to the You cannot copy or move a group of sheets that contain a table error if you move it conventionally via excel.

I have found the following code in a forum:

'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

The only thing is that it moves the copied sheets into an entirely new workbook. I tried using Before:=Workbooks("Destination.xlm").Sheets(Sheetname) after ThisWorkbook.Worksheets(strMyArray).Copy but it doesn't work.

How can I modify this macro to move the sheets in to an open, existing workbook instead of an entirely new workbook?

try with below code. Kindly edit Book2.xlsx in for loop with your target workbook

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

According to the MS documentation using an array selection of multiple worksheets for the .Copy method will result in the worksheets being put into a new workbook.

You will need to build a loop to transfer your sheets. Below is a simple example ...

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

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