使用VBA將整個Excel工作簿復制到另一個工作簿

Question

我有一個包含4個工作表的工作簿（“初始工作簿”）。
我需要將所有四個工作表復制到另一個工作簿（“新工作簿”）。

我有以下代碼，該代碼使我可以從“新工作簿”導航到“初始工作簿”，然后在一個工作表上復制特定范圍。 我想對此進行修改，以允許我選擇並復制原始工作表上的所有四個工作表。

您能提供的任何幫助將不勝感激：

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

Answer 1

奇跡般有效：

ActiveWorkbook.Sheets.Copy

（來源： http : //www.mrexcel.com/forum/excel-questions/404450-visual-basic-applications-copy-active-workbook-new-workbook.html ）

Answer 2

重新編寫的代碼應復制您的工作表：

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

只需根據需要替換工作表名稱。

（PS：如果您只是記錄一個宏，將工作表復制到另一個工作簿，然后查看生成的代碼，就可以自己找到這些命令！;-)）

Answer 3

我知道這是舊帖子，但是現有答案僅復制表格（不包括查詢等），並且這樣做的效率非常低。 下面的代碼對我來說就像一個魅力：

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

要使用，只需按以下方式調用它：

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

該代碼將工作簿的臨時副本保存在temp文件夾中，使用該臨時簿作為模板創建一個新工作簿，然后刪除該臨時工作簿。