Export to a new workbook/worksheet

This macro exports the values or formulas and charts from a worksheet range to a new workbook/worksheet:

Sub ExportRangeAsWB(SourceRange As Range, TargetFile As String, SaveValuesOnly As Boolean)
' Exports the data in the range SourceRange to
' the workbook TargetFile in standard workbook format
' Examples:
' ExportRangeAsWB Range("A1:M25"), "C:\FolderName\TargetWB.xls", True
' ExportRangeAsWB Worksheets("Sheet2").Range("A1:M25"), "C:\FolderName\TargetWB.xls", True

Dim r As Long, c As Integer, tr As Long
Dim TargetWB As Workbook, A As Integer
Dim co As ChartObject
    ' validate the input data if necessary
    If SourceRange Is Nothing Then Exit Sub
    
    If Len(Dir(TargetFile)) > 0 Then
        On Error Resume Next
        Kill TargetFile
        On Error GoTo 0
        If Len(Dir(TargetFile)) > 0 Then
            MsgBox TargetFile & _
                " already exists, rename, move or delete the file before you try again.", _
                vbInformation, "Export range to textfile"
            Exit Sub
        End If
    End If
    
    ' perform export
    Application.ScreenUpdating = False
    Set TargetWB = NewWorkbook(1) ' creates a new workbook with one worksheet
    tr = 1
    For A = 1 To SourceRange.Areas.Count
        SourceRange.Areas(A).Copy
        If SaveValuesOnly Then
            With Range("A" & tr)
                .PasteSpecial xlPasteValues
                .PasteSpecial xlPasteFormats
            End With
        Else
            Range("A" & tr).PasteSpecial xlPasteAll
        End If
        Application.CutCopyMode = False
        
        With SourceRange.Areas(A)
            ' set rowheights
            For r = 1 To .Rows.Count
                Rows(r).RowHeight = .Rows(r).RowHeight
            Next r
            ' set columnwidths
            For c = 1 To .Columns.Count
                Columns(c).ColumnWidth = .Columns(c).ColumnWidth
            Next c
        End With
        
        For Each co In SourceRange.Parent.ChartObjects
            ' Debug.Print co.TopLeftCell.Address, co.BottomRightCell.Address
            If Not Intersect(SourceRange.Areas(A), co.TopLeftCell) Is Nothing Then
                'If Not Intersect(SourceRange.Areas(A), co.BottomRightCell) Is Nothing Then
                If Not Intersect(SourceRange.Areas(A), co.BottomRightCell.Offset(-1, -1)) Is Nothing Then
                    ' the whole chart object is within the export range
                    co.Copy ' copy the chart object
                    Range(co.TopLeftCell.Address).PasteSpecial xlPasteAll ' paste the chart object
                End If
            End If
            
        Next co
        Set co = Nothing
        
        tr = tr + SourceRange.Areas(A).Rows.Count ' set the new target row
    Next A
    
    ' clean up
    Range("A1").Select
    TargetWB.SaveAs TargetFile
    'If TargetWB.Saved Then TargetWB.Close False ' close the new workbook
    Set TargetWB = Nothing
    Application.ScreenUpdating = True
End Sub

Private Function NewWorkbook(wsCount As Integer) As Workbook
' creates a new workbook with wsCount (1 to 255) worksheets
Dim OriginalWorksheetCount As Long
    Set NewWorkbook = Nothing
    If wsCount < 1 Or wsCount > 255 Then Exit Function
    OriginalWorksheetCount = Application.SheetsInNewWorkbook
    Application.SheetsInNewWorkbook = wsCount
    Set NewWorkbook = Workbooks.Add
    Application.SheetsInNewWorkbook = OriginalWorksheetCount
End Function

Document last updated 2006-07-11 20:10:04 Printerfriendly version

User comments:

hakan aydogan from belgium wrote (2006-11-20 21:14:21 CET):

how to export a column to access database *.mdb file
firs i import a table from an access .mdb file which has, product id`s, names, stock and price. i refresh the stock column according to orders and while closing the file, i want the updated stock information to be written in mdb file. just one column will be re-written. can you help?

Falgesh (fpsanghvi@gmail.com) from Mumbai, India wrote (2006-08-23 14:31:33 CET):

Modified version required-Request
[Request for consulting help removed, please use the e-mail address at the bottom of this page if you are requestion consulting help.]

Ole P. from Norway wrote (2006-07-11 20:10:43 CET):

Re: Export Chart
See the updated example above.

JR from UK wrote (2006-07-11 18:13:21 CET):

Export Chart
Great Function.
How would you include a chart object in the export ?