Question

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

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

我知道部分代码是：

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

Answer 1

未经测试，但类似：

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

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

Answer 2

你可以用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

Answer 3

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

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

Answer 4

我将发布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()

Answer 5

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

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

Answer 6

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

有关详细说明和屏幕截图，请参阅this link。

Answer 7

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

您可能必须编写两个宏类型的下载，然后从您在它们之间共享的位置进行拾取。也许工具栏上有一个命令按钮。

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

Answer 8

最简单的方法：

Dim newBook As Workbook  
Set newBook = Workbooks.Add

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

Answer 9

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

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

9 个答案: