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:
I am getting a runtime error 91 when running this code at line
WB1 = ActiveWorkbook
could you please help me
use 'set' to link the object
set WB1 = ActiveWorkbook
to unload from memory
set WB1 = nothing
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
Range("outputfile").Select
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)
Else
Workbooks.Add
End If
Set wkbDest = Nothing
Set wkbDest = ActiveWorkbook
'wkbDest.Worksheets(1).Activate
wkbProcess.Activate
Range("inputfile").Select
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
wkbSource.Close
Set wkbSource = Nothing
wkbProcess.Activate
ActiveCell.Offset(0, 1).Value = "Copy completed"
Else
ActiveCell.Offset(0, 1).Value = "Does not exist"
End If
ActiveCell.Offset(1, 0).Select
ActiveCell.Offset(0, 1).Value = ""
Loop
wkbDest.SaveAs (OutFile)
wkbDest.Close
MsgBox "Process has completed"
End Sub
Post a Comment