2

我有一个包含 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
4

3 回答 3

4

奇迹般有效：

ActiveWorkbook.Sheets.Copy

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

于 2016-01-19T15:10:11.080 回答
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 文件夹中，使用临时簿作为模板创建新工作簿，然后删除临时工作簿。

于 2018-10-01T15:46:17.907 回答
2

此重新编写的代码应复制您的工作表：

私有子 CommandButton1_Click()
    将 wkbSource 调暗为工作簿
    Dim wkbTarget As Workbook '更好地使用源和目标作为名称，因为它不那么混乱
    暗淡 strFileName 作为字符串

    设置 wkbSource = ActiveWorkbook

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

    If strFileName = "False" Then Exit Sub '确保您的语言环境也返回 False！

    设置 wkbTarget = Workbooks.Open(strFileName)
    wkbSource.Sheets（数组（“Sheet1”，“Sheet2”，“Sheet3”，“Sheet4”））。复制_
        之前：=wkbTarget.Sheets(1)
    '进一步的编辑在这里

    wkbTarget.Close False

结束子

只需根据您的需要替换工作表名称即可。

（PS：您可以自己找到这些命令，如果您只是记录一个宏，将工作表复制到另一个工作簿 - 然后查看生成的代码！;-)）

于 2013-01-31T08:13:18.857 回答