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

Question

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

Проблема в том, что программист использует JavaScript, и когда вы нажимаете на кнопку, которая передает веб-данные в книгу 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

Этот код копирует и вставляет все листы (не значения ячеек) из одной исходной рабочей книги в целевую рабочую книгу:

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 5

при вставке в Word форматирование / формула Excel все еще существует. Просто нажмите на буфер обмена и выберите опцию «сохранять только текст».

Answer 6

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

Dim newBook As Workbook  
Set newBook = Workbooks.Add

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

Answer 7

Я просто опубликую ответ для 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 8

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

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

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

Answer 9

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

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