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

如果您有两个使用VBA打开的Excel应用程序,如何将工作表从一个Excel应用程序(1)转移到另一个(2)?

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

我知道部分代码将是:

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

未经testing,但类似于:

 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 

请注意,这假定目标工作表已经存在。 如果没有,创build一个非常容易。

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

我正在使用这个代码,希望这有助于!

 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 

我只是要发布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() 

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

 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 

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

看到这个链接更详细的说明和截图。

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

你可能不得不编写两个macrostypes的下载,然后从它们之间共享的位置接收。 也许在工具栏上的一个命令button。

也许这里的超级球员之一有一个更好的答案。

最简单的方法:

 Dim newBook As Workbook Set newBook = Workbooks.Add Sheets("Sheet1").Copy Before:=newBook.Sheets(1) 

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