How to copy only a single worksheet to another workbook using vba

Question

I have 1 WorkBook  SOURCE   that contains around 20 Sheets  I want to copy only 1 particular sheet to another Workbook  TARGET   using Excel VBA    Please note that the  TARGET  Workbook doen t exist yet  It should be created at runtime   Methods Used -   1  Activeworkbook SaveAs  lt --- Doesn t work  This will copy all the sheets  I want only specific sheet

User · Answer

The much longer example below combines some of the useful snippets above:

You can specify any number of sheets you want to copy across
You can copy entire sheets, i.e. like dragging the tab across, or you can copy over the contents of cells as values-only but preserving formatting.

It could still do with a lot of work to make it better (better error-handling, general cleaning up), but it hopefully provides a good start.

Note that not all formatting is carried across because the new sheet uses its own theme's fonts and colours. I can't work out how to copy those across when pasting as values only.

 Option Explicit

Sub copyDataToNewFile()
    Application.ScreenUpdating = False

    ' Allow different ways of copying data:
    ' sheet = copy the entire sheet
    ' valuesWithFormatting = create a new sheet with the same name as the
    '                        original, copy values from the cells only, then
    '                        apply original formatting. Formatting is only as
    '                        good as the Paste Special > Formats command - theme
    '                        colours and fonts are not preserved.
    Dim copyMethod As String
    copyMethod = "valuesWithFormatting"

    Dim newFilename As String           ' Name (+optionally path) of new file
    Dim themeTempFilePath As String     ' To temporarily save the source file's theme

    Dim sourceWorkbook As Workbook      ' This file
    Set sourceWorkbook = ThisWorkbook

    Dim newWorkbook As Workbook         ' New file

    Dim sht As Worksheet                ' To iterate through sheets later on.
    Dim sheetFriendlyName As String     ' To store friendly sheet name
    Dim sheetCount As Long              ' To avoid having to count multiple times

    ' Sheets to copy over, using internal code names as more reliable.
    Dim colSheetObjectsToCopy As New Collection
    colSheetObjectsToCopy.Add Sheet1
    colSheetObjectsToCopy.Add Sheet2

    ' Get filename of new file from user.
    Do
        newFilename = InputBox("Please Specify the name of your new workbook." & vbCr & vbCr & "Either enter a full path or just a filename, in which case the file will be saved in the same location (" & sourceWorkbook.Path & "). Don't use the name of a workbook that is already open, otherwise this script will break.", "New Copy")
        If newFilename = "" Then MsgBox "You must enter something.", vbExclamation, "Filename needed"
    Loop Until newFilename > ""

    ' If they didn't supply a path, assume same location as the source workbook.
    ' Not perfect - simply assumes a path has been supplied if a path separator
    ' exists somewhere. Could still be a badly-formed path. And, no check is done
    ' to see if the path actually exists.
    If InStr(1, newFilename, Application.PathSeparator, vbTextCompare) = 0 Then
        newFilename = sourceWorkbook.Path & Application.PathSeparator & newFilename
    End If

    ' Create a new workbook and save as the user requested.
    ' NB This fails if the filename is the same as a workbook that's
    ' already open - it should check for this.
    Set newWorkbook = Application.Workbooks.Add(xlWBATWorksheet)
    newWorkbook.SaveAs Filename:=newFilename, _
        FileFormat:=xlWorkbookDefault

    ' Theme fonts and colours don't get copied over with most paste-special operations.
    ' This saves the theme of the source workbook and then loads it into the new workbook.
    ' BUG: Doesn't work!
    'themeTempFilePath = Environ("temp") & Application.PathSeparator & sourceWorkbook.Name & " - Theme.xml"
    'sourceWorkbook.Theme.ThemeFontScheme.Save themeTempFilePath
    'sourceWorkbook.Theme.ThemeColorScheme.Save themeTempFilePath
    'newWorkbook.Theme.ThemeFontScheme.Load themeTempFilePath
    'newWorkbook.Theme.ThemeColorScheme.Load themeTempFilePath
    'On Error Resume Next
    'Kill themeTempFilePath  ' kill = delete in VBA-speak
    'On Error GoTo 0


    ' getWorksheetNameFromObject returns null if the worksheet object doens't
    ' exist
    For Each sht In colSheetObjectsToCopy
        sheetFriendlyName = getWorksheetNameFromObject(sourceWorkbook, sht)
        Application.StatusBar = "VBL Copying " & sheetFriendlyName
        If Not IsNull(sheetFriendlyName) Then
            Select Case copyMethod
                Case "sheet"
                    sourceWorkbook.Sheets(sheetFriendlyName).Copy _
                        After:=newWorkbook.Sheets(newWorkbook.Sheets.count)
                Case "valuesWithFormatting"
                    newWorkbook.Sheets.Add After:=newWorkbook.Sheets(newWorkbook.Sheets.count), _
                        Type:=sourceWorkbook.Sheets(sheetFriendlyName).Type
                    sheetCount = newWorkbook.Sheets.count
                    newWorkbook.Sheets(sheetCount).Name = sheetFriendlyName
                    ' Copy all cells in current source sheet to the clipboard. Could copy straight
                    ' to the new workbook by specifying the Destination parameter but in this case
                    ' we want to do a paste special as values only and the Copy method doens't allow that.
                    sourceWorkbook.Sheets(sheetFriendlyName).Cells.Copy ' Destination:=newWorkbook.Sheets(newWorkbook.Sheets.Count).[A1]
                    newWorkbook.Sheets(sheetCount).[A1].PasteSpecial Paste:=xlValues
                    newWorkbook.Sheets(sheetCount).[A1].PasteSpecial Paste:=xlFormats
                    newWorkbook.Sheets(sheetCount).Tab.Color = sourceWorkbook.Sheets(sheetFriendlyName).Tab.Color
                    Application.CutCopyMode = False
            End Select
        End If
    Next sht

    Application.StatusBar = False
    Application.ScreenUpdating = True
    ActiveWorkbook.Save

User · Answer

To copy a sheet to a workbook called TARGET   Sheets  xyz   Copy After  Workbooks  TARGET xlsx   Sheets  abc     This will put the copied sheet xyz in the TARGET workbook after the sheet abc Obviously if you want to put the sheet in the TARGET workbook before a sheet  replace Before for After in the code   To create a workbook called TARGET you would first need to add a new workbook and then save it to define the filename   Application Workbooks Add  xlWBATWorksheet  ActiveWorkbook SaveAs   TARGET     However this may not be ideal for you as it will save the workbook in a default location e g  My Documents   Hopefully this will give you something to go on though

User · Answer

Sub ActiveSheet toDESKTOP As Workbook    Dim Oldname As String Dim MyRange As Range Dim MyWS As String  MyWS   ActiveCell Parent Name      Application DisplayAlerts   False  hide confirmation from user     Application ScreenUpdating   False     Oldname   ActiveSheet Name      Sheets Add Before  Sheets 1   Name    quot FirstSheet quot            Get path for desktop of user PC     Path   Environ  quot USERPROFILE quot    amp   quot  Desktop quot            ActiveSheet Cells Copy     Sheets Add After  Sheets Sheets Count   Name    quot TransferSheet quot      ActiveSheet Cells PasteSpecial Paste  xlPasteValues  Operation  xlNone  SkipBlanks  False  Transpose  False     ActiveSheet Cells PasteSpecial Paste  xlPasteFormats  Operation  xlNone  SkipBlanks  False  Transpose  False     ActiveSheet Cells Copy           Create new workbook and past copied data in new workbook  amp  save to desktop     Workbooks Add  xlWBATWorksheet      ActiveSheet Cells PasteSpecial Paste  xlPasteValues  Operation  xlNone  SkipBlanks  False  Transpose  False     ActiveSheet Cells PasteSpecial Paste  xlPasteFormats  Operation  xlNone  SkipBlanks  False  Transpose  False     ActiveSheet Cells 1  1  Select     ActiveWorkbook ActiveSheet Name   Oldname      quot report quot      ActiveWorkbook SaveAs Filename  Path  amp   quot   quot   amp  Oldname  amp   quot  WS  quot   amp  Format CStr Now      quot dd-mmm  hh mm ss AM PM  quot    amp   quot  xlsx quot      ActiveWorkbook Close SaveChanges  True           Sheets  quot TransferSheet quot   Delete              Application DisplayAlerts   True     Application ScreenUpdating   True     Worksheets MyWS  Activate      MsgBox  quot Exported to Desktop quot   End Sub

User · Answer

You can try this VBA program  Option Explicit   Sub CopyWorksheetsFomTemplate        Dim NewName As String      Dim nm As Name      Dim ws As Worksheet       If MsgBox  Copy specific sheets to a new workbook   amp  vbCr  amp          New sheets will be pasted as values  named ranges removed           vbYesNo   NewCopy     vbNo Then Exit Sub       With Application           ScreenUpdating   False                    Copy specific sheets                   SET THE SHEET NAMES TO COPY BELOW                   Array  Sheet Name    Another sheet name    And Another                     Sheet names go inside quotes  seperated by commas         On Error GoTo ErrCatcher          Sheets Array  Sheet1    Sheet2    Copy          On Error GoTo 0                    Paste sheets as values                  Remove External Links  Hperlinks and hard-code formulas                  Make sure A1 is selected on all sheets         For Each ws In ActiveWorkbook Worksheets              ws Cells Copy              ws  A1  PasteSpecial Paste  xlValues              ws Cells Hyperlinks Delete              Application CutCopyMode   False              Cells 1  1  Select              ws Activate          Next ws          Cells 1  1  Select                    Remove named ranges         For Each nm In ActiveWorkbook Names              nm Delete          Next nm                    Input box to name new file         NewName   InputBox  Please Specify the name of your new workbook    New Copy                      Save it with the NewName and in the same directory as original         ActiveWorkbook SaveCopyAs ThisWorkbook Path  amp       amp  NewName  amp    xls           ActiveWorkbook Close SaveChanges  False            ScreenUpdating   True      End With      Exit Sub   ErrCatcher       MsgBox  Specified sheets do not exist within this workbook    End Sub

User · Answer

I have 1 WorkBook  SOURCE   that contains around 20 Sheets  I want to copy only 1 particular sheet to another Workbook  TARGET   using Excel VBA  Please note that the  TARGET  Workbook doen t exist yet  It should be created at runtime    Another Way  Sub Sample           gt  Change Sheet1 to the relevant sheet         gt  This will create a new workbook with the relevant sheet     ThisWorkbook Sheets  Sheet1   Copy          gt  Save the new workbook     ActiveWorkbook SaveAs  C  Target xlsx   FileFormat  51 End Sub   This will automatically create a new workbook called Target xlsx with the relevant sheet

[vba] How to copy only a single worksheet to another workbook using vba

Examples related to vba

Examples related to excel