VB and VBA Users Source Code: Combining the contents of two Excel Workbooks
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Combining the contents of two Excel Workbooks
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Tuesday, November 13, 2001
Hits:
1024
Category:
Unspecified
Article:
The following code demonstrates how to combine the sheets from two workbooks. Option Explicit 'Purpose : Appends the contents of a workbooks into an existing workbook. 'Inputs : sPathToDestinationWorkbook The path to the destination workbook. ' sPathToSourceWorkbook The path to the workbook containing the source sheets. 'Output : Returns "SUCCESS" if succeeded, else returns the error description/ 'Author : Andrew Baker 'Date : 03/05/2001 13:50 'Notes : 'Revisions : Function WorkbooksCombine(sPathToDestinationWorkbook As String, sPathToSourceWorkbook As String) As String Const csUniqueSheetName As String = "²³" Dim wkDestination As Excel.Workbook, wkbSource As Workbook Dim shtToCopy As Object On Error GoTo ErrFailed 'Open the workbooks Set wkDestination = Application.Workbooks.Open(sPathToDestinationWorkbook) Set wkbSource = Application.Workbooks.Open(sPathToSourceWorkbook, , True) 'Copy sheets across For Each shtToCopy In wkbSource.Sheets shtToCopy.Copy wkDestination.Sheets(1) Next 'Save and close output workbook wkDestination.Save wkDestination.Close False Set wkDestination = Nothing 'Close the source workbook wkbSource.Close False Set wkbSource = Nothing WorkbooksCombine = "SUCCESS" Exit Function ErrFailed: WorkbooksCombine = Err.Description On Error GoTo 0 End Function 'Demonstration routine Sub Test() Dim sResult As String 'Place two workbooks in your c:\ directory with the names book1.xls and book2.xls sResult = WorkbooksCombine("C:\destination.xls", "C:\source.xls") If sResult = "SUCCESS" Then MsgBox "Book2.xls now contains the worksheets for Book1.xls... ", vbInformation Else MsgBox "Export failed..." & vbNewLine & sResult, vbExclamation End If End Sub
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
