vba 如何在 Excel 工作簿之间复制和粘贴工作表？

How to copy and paste worksheets between Excel workbooks?

提问by Stewart Johnson

How do you transfer a worksheet from one excel app(1) to another(2) if you have two excel apps open using VBA?

如果您使用 VBA 打开了两个 Excel 应用程序，如何将工作表从一个 Excel 应用程序（1）转移到另一个（2）？

The problem is, the programmer uses JavaScript, and when you click on the button that transfers the web data to a xl workbook, it opens a new Excel app.

问题是，程序员使用 JavaScript，当您单击将 Web 数据传输到 xl 工作簿的按钮时，它会打开一个新的 Excel 应用程序。

I know part of the code would be:

我知道部分代码是：

Workbooks.Add
ActiveSheet.Paste    
' Once I returned to the original , i.e. excel app(1).

回答by Stewart Johnson

Not tested, but something like:

未测试，但类似于：

Dim sourceSheet As Worksheet
Dim destSheet As Worksheet

'' copy from the source
Workbooks.Open Filename:="c:\source.xls"
Set sourceSheet = Worksheets("source")
sourceSheet.Activate
sourceSheet.Cells.Select
Selection.Copy

'' paste to the destination
Workbooks.Open Filename:="c:\destination.xls"
Set destSheet = Worksheets("dest")
destSheet.Activate
destSheet.Cells.Select
destSheet.Paste

'' save & close
ActiveWorkbook.Save
ActiveWorkbook.Close

Note that this assumes the destination sheet already exists. It's pretty easy to create one if it doesn't.

请注意，这假定目标工作表已存在。如果没有，创建一个很容易。

回答by Fionnuala

You could do something with APIs.

你可以用 API 做一些事情。

Private Const SW_SHOW = 5
Private Const GW_HWNDNEXT = 2

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function ShowWindow Lib "user32" _
(ByVal hWnd As Long, ByVal nCmdShow As Long) As Long

Private Declare Function GetWindow Lib "user32" _
(ByVal hWnd As Long, ByVal wCmd As Long) As Long

Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
(ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

Function FindWindowPartialX(ByVal Title As String) As Long
    Dim hWndThis As Long
    hWndThis = FindWindow(vbNullString, vbNullString)
    While hWndThis
        Dim sTitle As String, sClass As String
        sTitle = Space$(255)
        sTitle = Left$(sTitle, GetWindowText(hWndThis, sTitle, Len(sTitle)))
        sClass = Space$(255)
        sClass = Left$(sClass, GetClassName(hWndThis, sClass, Len(sClass)))
        If InStr(sTitle, Title) > 0 Then
            FindWindowPartialX = hWndThis
            Exit Function
        End If
        hWndThis = GetWindow(hWndThis, GW_HWNDNEXT)
    Wend
End Function

Sub CopySheet()
Dim objXL As Excel.Application

' A suitable portion of the window title such as file name '
WinHandle = FindWindowPartialX("LTD.xls")

ShowWindow WinHandle, SW_SHOW

Set objXL = GetObject(, "Excel.Application")

objXL.Worksheets("Source").Activate
objXL.ActiveSheet.UsedRange.Copy

Application.ActiveSheet.Paste
End Sub

回答by Javier Torón

I'm using this code, hope this helps!

我正在使用此代码，希望这会有所帮助！

Application.ScreenUpdating = False
Application.EnableEvents = False

Dim destination_wb As Workbook
Set destination_wb = Workbooks.Open(DESTINATION_WORKBOOK_NAME)

worksheet_to_copy.Copy Before:=destination_wb.Worksheets(1)
destination_wb.Worksheets(1).Name = worksheet_to_copy.Name
'Add the sheets count to the name to avoid repeated worksheet names error
'& destination_wb.Worksheets.Count


'optional
destination_wb.Worksheets(1).UsedRange.Columns.AutoFit

'I use this to avoid macro errors in destination_wb
Call DeleteAllVBACode(destination_wb)

'Delete source worksheet
Application.DisplayAlerts = False
worksheet_to_copy.Delete
Application.DisplayAlerts = True

destination_wb.Save
destination_wb.Close

Application.EnableEvents = True
Application.ScreenUpdating = True

---

---

' From http://www.cpearson.com/Excel/vbe.aspx           

Public Sub DeleteAllVBACode(libro As Workbook)
    Dim VBProj As VBProject
    Dim VBComp As VBComponent
    Dim CodeMod As CodeModule

    Set VBProj = libro.VBProject

    For Each VBComp In VBProj.VBComponents
        If VBComp.Type = vbext_ct_Document Then
            Set CodeMod = VBComp.CodeModule
            With CodeMod
                .DeleteLines 1, .CountOfLines
            End With
        Else
            VBProj.VBComponents.Remove VBComp
        End If
    Next VBComp
End Sub

回答by Thorvaldur

I am just going to post the answer for python so people will have a reference.

我只是要发布python的答案，以便人们有参考。

from win32com.client import Dispatch
from win32com.client import constants
import win32com.client

xlApp = Dispatch("Excel.Application")
xlWb = xlApp.Workbooks.Open(filename_xls)
ws = xlWb.Worksheets(1)
xlApp.Visible=False
xlWbTemplate = xlApp.Workbooks.Open('otherfile.xls')
ws_sub = xlWbTemplate.Worksheets(1)
ws_sub.Activate()
xlWbTemplate.Worksheets(2).Copy(None,xlWb.Worksheets(1))
ws_sub = xlWbTemplate.Worksheets(2)
ws_sub.Activate()

xlWbTemplate.Close(SaveChanges=0)
xlWb.Worksheets(1).Activate()
xlWb.Close(SaveChanges=1)
xlApp.Quit()

回答by Jaime Sacristán

This code copies and pastes all sheets (not cell values) from one source workbook to a destination workbook:

此代码将所有工作表（不是单元格值）从一个源工作簿复制并粘贴到目标工作簿：

Private Sub copypastesheets()

Dim wbSource, wbDestination As Object
Dim nbSheets As Integer

Set wbSource = Workbooks("your_source_workbook_name")
Set wbDestination = Workbooks("your_destination_workbook_name")
nbSheets = wbDestination.Sheets.Count - 1

For Each sheetItem In wbSource.Sheets

    nbSheets = nbSheets + 1
    sheetItem.Copy after:=wbDestination.Sheets(nbSheets)

Next sheetItem


End Sub

回答by e.James

You can also do this without any code at all. If you right-click on the little sheet tab at the bottom of the sheet, and select "Move or Copy", you will get a dialog box that lets you choose which open workbook to transfer the sheet to.

您也可以在没有任何代码的情况下执行此操作。如果您右键单击工作表底部的小工作表选项卡，然后选择“移动或复制”，您将看到一个对话框，让您选择要将工作表转移到哪个打开的工作簿。

See this linkfor more detailed instructions and screenshots.

有关更详细的说明和屏幕截图，请参阅此链接。

回答by CABecker

To be honest I don't know that you can. If you just set up a test instance and open Excel twice, because that is what you are talking about happening, if you name one workbook "test1" and another "test2" if you try to move a workbook, or even a worksheet between the two applications they are totally unaware of each other. I also notice odd behavior while simply manually cutting and pasting from Excel instance 1 and Excel instance 2.

老实说，我不知道你可以。如果您只是设置一个测试实例并打开 Excel 两次，因为这就是您正在谈论的事情，如果您将一个工作簿命名为“test1”，另一个“test2”，如果您尝试移动工作簿，甚至在两个工作簿之间移动工作表两个应用程序，他们完全不知道对方。我还注意到奇怪的行为，而只是从 Excel 实例 1 和 Excel 实例 2 手动剪切和粘贴。

You may have to write two macros kind of a drop off and then a pick up from a location that you share between them. Maybe a command button on the tool bar.

您可能需要编写两个宏，一种是下车，然后是从您在它们之间共享的位置上车。也许是工具栏上的命令按钮。

Maybe one of the super excel guys on here have a better answer.

也许这里的一位超级优秀的人有更好的答案。

回答by Nick

easiest way:

最简单的方法：

Dim newBook As Workbook  
Set newBook = Workbooks.Add

Sheets("Sheet1").Copy Before:=newBook.Sheets(1)

回答by toosh

when you paste into Word, the formating/formula of excel still exists. Simply click the clip board and select the option "keep text only."

当你粘贴到Word中时，excel的格式/公式仍然存在。只需单击剪贴板并选择“仅保留文本”选项。