Hi
How do you transfer a worksheet from one excel app(1) to another(2) if you have two excel apps open using VBA?
The problem is, the programmer uses javascript, and when you click on the button that transfers the web data to a xl workbook, it opens a new Excel app.
I know part of the code would be:
Workbooks.Add
ActiveSheet.Paste
'Once I returned to the original , i.e. excel app(1).
Please could someone help me.
What about the following steps:
Not tested, but something like:
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
Note that this assumes the destination sheet already exists. It's pretty easy to create one if it doesn't.
You can also do this without any code at all. If you right-click on the little sheet tab at the bottom of the sheet, and select "Move or Copy", you will get a dialog box that lets you choose which open workbook to transfer the sheet to.
See this link for more detailed instructions and screenshots.
To be honest I don't know that you can. If you just set up a test instance and open Excel twice, because that is what you are talking about happening, if you name one workbook "test1" and another "test2" if you try to move a workbook, or even a worksheet between the two applications they are totally unaware of each other. I also notice odd behavior while simply manually cutting and pasting from Excel instance 1 and Excel instance 2.
You may have to write two macros kind of a drop off and then a pick up from a location that you share between them. Maybe a command button on the tool bar.
Maybe one of the super excel guys on here have a better answer.
You could do something with APIs.
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
Hello! I'm using this code, hope this helps!
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
I am just going to post the answer for python so people will have a reference.
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()
For an added bonus. Does any one know how to do this without opening an excel file, (say mixing xlrd and xlwt or pyExcelerator)?
easiest way:
Dim newBook As Workbook
Set newBook = Workbooks.Add
Sheets("Sheet1").Copy Before:=newBook.Sheets(1)