VBA – Copy all Worksheets to another Workbook

If you want to copy all of your worksheets from the actual workbook to another workbook, you can use this simple VBA code to do it.

Sub copy_sheets()

    Dim wb1 As Workbook
    Dim wb2 As Workbook
    wb1 = ActiveWorkbook
    'Change the name of the destination workbook here
    wb2 = Workbooks("Destination.xls")
    For Each Sheet In wb1.Sheets
        If Sheet.Visible = True Then
            'copy the sheets after the last
            'sheet of the destination workbook
            Sheet.Copy After:=wb2.Sheets(wb2.Sheets.Count)
        End If
    Next Sheet

End Sub

3 comentários:

Abilash said...

I am getting a runtime error 91 when running this code at line
WB1 = ActiveWorkbook
could you please help me

Anonymous said...

use 'set' to link the object

set WB1 = ActiveWorkbook

to unload from memory

set WB1 = nothing

Anonymous said...

This is working wonderfully well. My only issue is that I am getting "Code execution has been interrupted" intermittently. I am not sure what is causing this. It doesn't always happen in the same place and not all the time.

Here is my code for the entire macro. I have a template file where I place the input file names as well as the output file name.

Sub cmdStart()
Dim wkbSource As Workbook
Dim wkbDest As Workbook
Dim wkbProcess As Workbook
Dim OutFile As String
Dim InFile As String
Dim iExist As Integer
Dim iInCount As Integer
Dim iOutCount As Integer
Dim fso

On Error Resume Next

Application.DisplayAlerts = False

Set wkbProcess = Nothing
Set wkbProcess = ActiveWorkbook
Set fso = CreateObject("Scripting.FileSystemObject")

'Get output file and open
ActiveCell.Offset(1, 0).Select
OutFile = ActiveCell.Value

'If the file exists, then open otherwise create
If fso.FileExists(OutFile) Then
wkbSource = Workbooks.Open(OutFile)
End If

Set wkbDest = Nothing
Set wkbDest = ActiveWorkbook

ActiveCell.Offset(1, 0).Select
ActiveCell.Offset(0, 1).Value = ""

Do Until Len(Trim(ActiveCell.Value)) = 0
InFile = ActiveCell.Value
If fso.FileExists(InFile) Then
Workbooks.Open (InFile)
Set wkbSource = Nothing
Set wkbSource = ActiveWorkbook
For Each Sheet In wkbSource.Sheets
Sheet.Copy after:=wkbDest.Sheets(wkbDest.Sheets.Count)
Next Sheet
Set wkbSource = Nothing
ActiveCell.Offset(0, 1).Value = "Copy completed"
ActiveCell.Offset(0, 1).Value = "Does not exist"
End If
ActiveCell.Offset(1, 0).Select
ActiveCell.Offset(0, 1).Value = ""
wkbDest.SaveAs (OutFile)
MsgBox "Process has completed"
End Sub