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

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

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

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

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

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

Если честно, я не знаю, что можно. Если вы просто настроили тестовый экземпляр и дважды открыли Excel, потому что это то, о чем вы говорите, происходит, если вы назовете одну книгу «test1», а другую «test2», если вы попытаетесь переместить книгу, или даже рабочий лист между два приложения они совершенно не знают друг друга. Я также заметил странное поведение при простом вырезании и вставке вручную из экземпляра Excel 1 и экземпляра Excel 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

Я использую этот код, надеюсь, это поможет!

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()

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

Dim newBook As Workbook  
Set newBook = Workbooks.Add

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

когда вы вставляете в Word, форматирование / формула Excel все еще существует. Просто щелкните буфер обмена и выберите вариант «сохранить только текст».

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

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