首页 文章

使用VBA将整个Excel工作簿复制到另一个工作簿

提问于
浏览 次
0

我有一个包含4个工作表的工作簿（"Initial Workbook"） .
我需要将所有四个工作表复制到另一个工作簿（"New Workbook"） .

我有以下代码，允许我从新工作簿导航到初始工作簿，然后在一个工作表上复制特定范围 . 我想修改它以允许我选择并复制原始工作表上的所有四个工作表 .

我们非常感谢您提供的任何帮助：

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
excel vba excel-vba

3 回答

  • 3
    回复于
  • 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：你可以自己找到这些命令，如果你只是记录一个宏，你将工作表复制到另一个工作簿 - 然后查看生成的代码！;-)）

    回复于
  • 1

    我知道这是一个旧帖子，但现有的答案只复制表格（不包括查询等），并且效率非常低 . 以下代码对我来说就像一个魅力：

    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)

    代码在临时文件夹中保存工作簿的临时副本，使用临时工作簿作为模板创建新工作簿，然后删除临时工作簿 .

    回复于

相关问题