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.