CODEWITHSUNDEEP
vbaexcel
KiwiRyu
KiwiRyu

Reputation: 31

Copying an entire excel workbook to another workbook using VBA

I have a workbook with 4 worksheets ("Initial Workbook").
I need to copy all four worksheets to a different workbook("New Workbook").

I have the below code which allows me to navigate to the Initial Workbook from the New Workbook and then copy a specific range on one worksheet. I would like to amend this to allow me to select and copy all four of the worksheets on the Original Worksheet.

Any help you can provide would be most appreciated:

Private Sub CommandButton1_Click()

    Dim wkbCrntWorkBook As Workbook
    Dim wkbSourceBook As Workbook

    Dim rngSourceRange As Range
    Dim rngDestination As Range

    Set wkbCrntWorkBook = ActiveWorkbook

    With Application.FileDialog(msoFileDialogOpen)
        .Filters.Clear
        .Filters.Add "Excel 2002-03", "*.xls", 1
        .Filters.Add "Excel 2007", "*.xlsx; *.xlsm; *.xlsa", 2
        .AllowMultiSelect = False
        .Show

        If .SelectedItems.Count > 0 Then
            Workbooks.Open .SelectedItems(1)
            Set wkbSourceBook = ActiveWorkbook
            Set rngSourceRange = Application.InputBox(prompt:="Select source range", Title:="Source Range", Default:="$A:$CS", Type:=8)
            wkbCrntWorkBook.Activate
            Set rngDestination = Application.InputBox(prompt:="Select destination cell", Title:="Select Destination", Default:="A1", Type:=8)
            rngSourceRange.Copy rngDestination
            rngDestination.CurrentRegion.EntireColumn.AutoFit
            wkbSourceBook.Close False
        End If
    End With

End Sub

Upvotes: 2

Views: 36479

Answers (3)

Jeremy Morren
Jeremy Morren

Reputation: 764

I know this is an old post, but the existing answers only copy Sheets (excluding Queries etc), and do so very inefficiently. The below code works like a charm for me: 

Function duplicateWorkbook(wk As Workbook) As Workbook
    Dim path As String
    path = Environ("temp") & "\" & wk.Name & "." & _ 
        Right(wk.FullName, Len(wk.FullName) - InStrRev(wk.FullName, "."))
    wk.SaveCopyAs path
    Set duplicateWorkbook = Workbooks.Add(path)
    Kill path
End Function

To use, simply call it as below:

Dim wk AS Workbook: Set wk = duplicateWorkbook(ActiveWorkbook)

The code saves a temporary copy of the workbook in the temp Folder, creates a new workbook using the temporary book as a template, and then deletes the temporary workbook.

Upvotes: 4

Orina
Orina

Reputation: 61

works like a charm:

ActiveWorkbook.Sheets.Copy

(Source:http://www.mrexcel.com/forum/excel-questions/404450-visual-basic-applications-copy-active-workbook-new-workbook.html)

Upvotes: 6

Peter Albert
Peter Albert

Reputation: 17495

This reworked code should copy your worksheets:

Private Sub CommandButton1_Click()
    Dim wkbSource As Workbook
    Dim wkbTarget As Workbook 'better use source and target as names, as its less confusing
    Dim strFileName As String

    Set wkbSource = ActiveWorkbook

    strFileName = Application.GetOpenFilename( _
        "Excel 2002-03 (*.xls), *.txt, " & _
        "Excel 2007 (*.xlsx; *.xlsm; *.xlsa), *.xlsx; *.xlsm; *.xlsa")

    If strFileName = "False" Then Exit Sub 'make sure that your locale also returns False!

    Set wkbTarget = Workbooks.Open(strFileName)
    wkbSource.Sheets(Array("Sheet1", "Sheet2", "Sheet3", "Sheet4")).Copy _
        Before:=wkbTarget.Sheets(1)
    'Further editing goes here

    wkbTarget.Close False

End Sub

Just replace the sheet names according to your needs.

(PS: You can find these commands yourself, if you simply record a macro where you copy the sheets to another workbook - and then look at the produced code! ;-) )

Upvotes: 2

Related Questions