vba 如何使用vba将工作表复制到另一个工作簿？

How to copy sheets to another workbook using vba?

提问by Brian

So, what I want to do, generally, is make a copy of a workbook. However, the source workbook is running my macros, and I want it to make an identical copy of itself, but without the macros. I feel like there should be a simple way to do this with VBA, but have yet to find it. I am considering copying the sheets one by one to the new workbook, which I will create. How would I do this? Is there a better way?

所以，我想要做的，通常是制作一份工作簿的副本。但是，源工作簿正在运行我的宏，我希望它制作自己的相同副本，但没有宏。我觉得应该有一种简单的方法可以用 VBA 做到这一点，但还没有找到。我正在考虑将工作表一张一张地复制到我将创建的新工作簿中。我该怎么做？有没有更好的办法？

回答by Patrick Honorez

I would like to slightly rewrite keytarhero's response:

我想稍微改写 keytarhero 的回复：

Sub CopyWorkbook()

Dim sh as Worksheet,  wb as workbook

Set wb = workbooks("Target workbook")
For Each sh in workbooks("source workbook").Worksheets
   sh.Copy After:=wb.Sheets(wb.sheets.count) 
Next sh

End Sub

---

---

Edit: You can also build an array of sheet names and copy that at once.

编辑：您还可以构建一个工作表名称数组并立即复制。

Workbooks("source workbook").Worksheets(Array("sheet1","sheet2")).Copy _
         After:=wb.Sheets(wb.sheets.count)

Note: copying a sheet from an XLS? to an XLS will result into an error. The opposite works fine (XLS to XLSX)

注意：从 XLS 复制工作表？XLS 将导致错误。相反的工作正常（XLS 到 XLSX）

回答by Chris Flynn

Someone over at Ozgridanswered a similar question. Basically, you just copy each sheet one at a time from Workbook1 to Workbook2.

Ozgrid 的某个人回答了类似的问题。基本上，您只需将每个工作表一次从 Workbook1 复制到 Workbook2。

Sub CopyWorkbook()

    Dim currentSheet as Worksheet
    Dim sheetIndex as Integer
    sheetIndex = 1

    For Each currentSheet in Worksheets

        Windows("SOURCE WORKBOOK").Activate 
        currentSheet.Select
        currentSheet.Copy Before:=Workbooks("TARGET WORKBOOK").Sheets(sheetIndex) 

        sheetIndex = sheetIndex + 1

    Next currentSheet

End Sub

Disclaimer: I haven't tried this code out and instead just adopted the linked example to your problem. If nothing else, it should lead you towards your intended solution.

免责声明：我还没有尝试过这段代码，而是采用了链接示例来解决您的问题。如果不出意外，它应该会引导您走向预期的解决方案。

回答by Brad

You could saveAs xlsx. Then you will loose the macros and generate a new workbook with a little less work.

你可以另存为 xlsx。然后，您将松开宏并以更少的工作生成一个新的工作簿。

ThisWorkbook.saveas Filename:=NewFileNameWithPath, Format:=xlOpenXMLWorkbook

回答by George Ziniewicz

I was able to copy all the sheets in a workbook that had a vba app running, to a new workbook w/o the app macros, with:

我能够将运行 vba 应用程序的工作簿中的所有工作表复制到没有应用程序宏的新工作簿中，使用：

ActiveWorkbook.Sheets.Copy

回答by Hors2force

You can simply write

你可以简单地写

Worksheets.Copy

in lieu of running a cycle. By default the worksheet collection is reproduced in a new workbook.

代替运行一个循环。默认情况下，工作表集合会在新工作簿中重现。

It is proven to function in 2010 version of XL.

它被证明可以在 2010 版的 XL 中运行。

回答by Ch3knraz3

Try this instead.

试试这个。

Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
    ws.Copy
Next

回答by raven

Assuming all your macros are in modules, maybe this linkwill help. After copying the workbook, just iterate over each module and delete it

假设你所有的宏都在模块中，也许这个链接会有所帮助。复制工作簿后，只需遍历每个模块并删除它

回答by Sainath J

    Workbooks.Open Filename:="Path(Ex: C:\Reports\ClientWiseReport.xls)"ReadOnly:=True


    For Each Sheet In ActiveWorkbook.Sheets

        Sheet.Copy After:=ThisWorkbook.Sheets(1)

    Next Sheet

回答by Ringo Boinker

Here is one you might like it uses the Windows FileDialog(msoFileDialogFilePicker) to browse to a closed workbook on your desktop, then copies all of the worksheets to your open workbook:

这是您可能喜欢的一个，它使用 Windows FileDialog(msoFileDialogFilePicker) 浏览到桌面上已关闭的工作簿，然后将所有工作表复制到打开的工作簿中：

Sub CopyWorkBookFullv2()
Application.ScreenUpdating = False

Dim ws As Worksheet
Dim x As Integer
Dim closedBook As Workbook
Dim cell As Range
Dim numSheets As Integer
Dim LString As String
Dim LArray() As String
Dim dashpos As Long
Dim FileName As String

numSheets = 0

For Each ws In Application.ActiveWorkbook.Worksheets
    If ws.Name <> "Sheet1" Then
       Sheets.Add.Name = "Sheet1"
   End If
Next

Dim fileExplorer As FileDialog
Set fileExplorer = Application.FileDialog(msoFileDialogFilePicker)
Dim MyString As String

fileExplorer.AllowMultiSelect = False

  With fileExplorer
     If .Show = -1 Then 'Any file is selected
     MyString = .SelectedItems.Item(1)

     Else ' else dialog is cancelled
        MsgBox "You have cancelled the dialogue"
        [filePath] = "" ' when cancelled set blank as file path.
        End If
    End With

    LString = Range("A1").Value
    dashpos = InStr(1, LString, "\") + 1
    LArray = Split(LString, "\")
    'MsgBox LArray(dashpos - 1)
    FileName = LArray(dashpos)

strFileName = CreateObject("WScript.Shell").specialfolders("Desktop") & "\" & FileName

Set closedBook = Workbooks.Open(strFileName)
closedBook.Application.ScreenUpdating = False
numSheets = closedBook.Sheets.Count

        For x = 1 To numSheets
            closedBook.Sheets(x).Copy After:=ThisWorkbook.Sheets(1)
        x = x + 1
                 If x = numSheets Then
                    GoTo 1000
                 End If
Next

1000

closedBook.Application.ScreenUpdating = True
closedBook.Close
Application.ScreenUpdating = True

End Sub