VB and VBA Users Source Code: Exporting Excel worksheets to a new workbook
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Exporting Excel worksheets to a new workbook
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Tuesday, March 13, 2001
Hits:
3165
Category:
Office
Article:
The following routines demonstrate how to export Excel worksheets to a new workbook. Option Explicit 'Purpose : Exports sheets from a workbook to a new workbook. 'Inputs : sExportToPath The path to save the new workbook to. ' wkbExportFrom The workbook to export the sheets from. ' bOverWrite If True alters overwrites any existing files. ' [asSheetNames] A parameter list containing the sheet names to export. ' eg. "Sheet1", "Sheet2" etc. 'Outputs : Returns "SUCCESS" if succeeded, else returns the error description/ 'Author : Andrew Baker 'Date : 03/05/2001 13:50 'Notes : 'Revisions : Function ExportSheets(sExportToPath As String, wkbExportFrom As Workbook, bOverWrite As Boolean, ParamArray asSheetNames() As Variant) As String Const csUniqueSheetName As String = "²³" Dim wkNew As Excel.Workbook, lOldNumSheets As Long, bOldDisplayAlerts As Boolean If bOverWrite Then On Error Resume Next 'Delete existing workbook VBA.Kill sExportToPath End If On Error GoTo ErrFailed 'Create new workbook lOldNumSheets = Application.SheetsInNewWorkbook Application.SheetsInNewWorkbook = 1 Set wkNew = Application.Workbooks.Add 'Copy sheets across wkNew.Sheets(1).Name = csUniqueSheetName wkbExportFrom.Sheets(asSheetNames).Copy Before:=wkNew.Sheets(1) bOldDisplayAlerts = Application.DisplayAlerts Application.DisplayAlerts = False wkNew.Sheets(csUniqueSheetName).Delete Application.DisplayAlerts = bOldDisplayAlerts 'Save and close new workbook wkNew.SaveAs sExportToPath wkNew.Close Set wkNew = Nothing Application.SheetsInNewWorkbook = lOldNumSheets ExportSheets = "SUCCESS" Exit Function ErrFailed: ExportSheets = Err.Description Application.SheetsInNewWorkbook = lOldNumSheets On Error GoTo 0 End Function 'Demonstration routine Sub Test() Dim sResult As String sResult = ExportSheets("C:\Export ~ " & Format$(Now, "dd mmm yyyy hh-mm") & ".xls", ThisWorkbook, True, "Sheet1", "Sheet2", "Sheet3") If sResult = "SUCCESS" Then MsgBox "Successfully exported sheets", 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
