Как скопировать и вставить рабочие листы между книгами Excel?

Как вы переносите лист из одного приложения excel (1) в другое (2), если у вас есть два приложения excel, открытые с помощью VBA?

Проблема заключается в том, что программист использует JavaScript, и когда вы нажимаете на кнопку, которая передает веб-данные в рабочую книгу xl, она открывает новое приложение Excel.

Я знаю, что часть кода будет:

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

Не тестировалось, но что-то вроде:

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

Обратите внимание, что это предполагает, что лист адресата уже существует. Это довольно легко создать, если это не так.


Вы можете что-то сделать с 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


Вы также можете сделать это без какого-либо кода. Если вы щелкните правой кнопкой мыши на вкладке маленького листа внизу листа и выберите "Переместить или скопировать", вы получите диалоговое окно, позволяющее выбрать, какую открытую книгу переносить на лист.

См. эту ссылку для получения более подробных инструкций и скриншотов.


Самый простой способ:

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


Честно говоря, я не знаю, что вы можете. Если вы просто настроили тестовый экземпляр и дважды открываете Excel, потому что это то, о чем вы говорите, если вы назовете одну книгу "test1" и другую "test2", если вы попытаетесь переместить книгу или даже рабочий лист между в двух приложениях они совершенно не знают друг о друге. Я также замечаю странное поведение, просто ручную резку и вставку из экземпляра Excel 1 и экземпляра Excel 2.

Возможно, вам придется написать два макроса, которые вы можете удалить, а затем забрать из местоположения, которое вы разделяете между ними. Возможно, кнопка на панели инструментов.

Может быть, у одного из суперчеловеков есть лучший ответ.


когда вы вставляете в Word, формация/формула excel все еще существует. Просто нажмите на панель клипов и выберите вариант "сохранить только текст".

licensed under cc by-sa 3.0 with attribution.