I am trying to copy data from one open instance in excel and load it into a separate open instance. I have the following code but it only copies data from the source workbook since the last save. Also this code can only be run from the destination workbook. Any help would be greatly appreciated.
Sub CollectA()
Dim oApp As Application
Dim oWb As Workbook
Set oWb = GetObject("Test two.xlsm")
Set oApp = oWb.Parent
oWb.Activate
oWb.ActiveSheet.Range("A1").Select
Selection.Copy
Workbooks("Test three.xlsm").Worksheets("Sheet1").Range("B1").PasteSpecial Paste:=xlPasteValues
End Sub
Avoid copy/paste whenever possible:
Sub CollectA()
Dim oWb As Workbook
Set oWb = GetObject("Test two.xlsm")
Workbooks("Test three.xlsm").Worksheets("Sheet1").Range("B1").Value = oWb.ActiveSheet.Range("A1").Value
End Sub
If you want the macro to be in "Test two":
Sub CollectA()
Dim oWb As Workbook
Set oWb = GetObject("Test three.xlsm")
owb.Worksheets("Sheet1").Range("B1").Value = Workbooks("Test two.xlsm").ActiveSheet.Range("A1").Value
End Sub
Related
My codes seems to only locate the worksheets in the workbook that is currently opening. When I go back after the workbook is already open and hit F5 on the Workbook_Open sub it then locates all the worksheets in every open workbook like it should. Not sure if this is a limitation on Excel. Any pointers are helpful.
Essentially the goal of the code is to make clicking hyperlinks in other workbooks execute a macro housed in this workbook. If anyone knows of a better way to do that I am all ears.
In "ThisWorkbook"
Private Sub Workbook_Open()
Call CreateClassesNEWWB
End Sub
In "Module 2"
Public objCollection As Collection
Sub CreateClassesNEWWB()
'allows hyperlinks in other workbooks to be driven off sub in this workbook
Dim ws As Worksheet
Dim HyperlinksClass As cHyperlinks
'Create A New Instance Of The Collection
Set objCollection = New Collection
'Loop All Worksheets
For Each ws In Worksheets
'Create A New Class For This Worksheet
Set HyperlinksClass = New cHyperlinks
'Add The Worksheet To The Class
Set HyperlinksClass.obj = ws
'Add The Class To The Collection
objCollection.Add HyperlinksClass
Next ws
End Sub
In Class Module "cHyperlinks"
Private WithEvents Pws As Worksheet
Private Sub Pws_FollowHyperlink(ByVal Target As Hyperlink)
Select Case Target.TextToDisplay
Case "Transpose": Call TransposeWire
Case "Research": Call Research
End Select
End Sub
Property Set obj(ByVal objWS As Worksheet)
Set Pws = objWS
End Property
Sub CreateClassesNEWWB()
'allows hyperlinks in other workbooks to be driven off sub in this workbook
Dim ws As Worksheet
Dim HyperlinksClass As cHyperlinks
'Create A New Instance Of The Collection
Set objCollection = New Collection
For Each wb In Workbooks '<loop workbooks
For Each ws In wb.Worksheets '<loop worksheets
objCollection.Add LinkHandler(ws)
Next ws
Next wb
End Sub
'I like "factory" functions partly to be sure
' I'm creating all objects as independent instances...
Function LinkHandler(ws As Worksheet) As cHyperlinks
Dim rv As New cHyperlinks
Set rv.obj = ws
Set LinkHandler = rv
End Function
I'm sorry but after three days I Give Up... So I'm asking what should be a very simple question but every example I find opens an Excel file or opens a read Only version of the same file, to do something where as in my case the file has already been opened from another macro using the code below, I just can't seem to figure how to adapt it for a file already open??
I'm also trying to figure out how to move excel to the active window from within the code? I would really appreciate any help
Dim oApp As Object
Dim x As Variant
Dim sPath As String
Dim oExcel As Excel.Application
Dim oWB As Workbook
Dim oSheet As String
sPath = "E:\Special Folders\WWWRoot\temp.xlsx"
oSheet = "--Keywording--"
On Error Resume Next
Set oExcel = New Excel.Application
Set oWB = oExcel.Workbooks.Open(sPath)
oExcel.Visible = True
Sheets(oSheet).Select
Range("A1:G1000").Clear
Range("A1").Select
Sheets(oSheet).Cells(1, 1).Select
Sheets(oSheet).PasteSpecial (xlPasteAll)
Range("A1").Select
Sorry, but can't you just turn on the Macro Recorder and get what you want?
Sub TryThis()
Windows("SecondaryWorkbook.xlsb").Activate
Range("A1").Select
Windows("PrimaryWorkbook.xls").Activate
Range("A1").Select
End Sub
I believe you need to be in the same instance of Excel, or this wonr't work. AFAIK, different instances of Excel don't communicate with each other...at all.
I am trying to copy a worksheet from the workbook that the VBA is in (ThisWorkbook) and past it into another workbook that the user has open (ActiveWorkbook). I have written a function but I cannot get it to work. I have done something similar before and I have searched the internet but I cannot find a solution or why it is failing me. What am I doing wrong?
Function workBooks() As String
aWbkName = ActiveWorkbook.Name
tWbkName = ThisWorkbook.Name
Dim wbk1 As Workbook
Dim wbk2 As Workbook
Set wbk1 = tWbkName
Set wbk2 = aWbkName
wbk1.Sheet2.Copy After:=wbk2.Sheets(7)
End Function
Try this and see if it works. It will copy Sheet2 in ThisWorkbook and paste it after Sheet1 in the ActiveWorkbook
Option Explicit
Public Sub copy_sheet()
Dim source_worksheet As Worksheet
Set source_worksheet = ThisWorkbook.Worksheets("Sheet2")
Dim target_worksheet As Worksheet
Set target_worksheet = ActiveWorkbook.Worksheets("Sheet1")
source_worksheet.Copy After:=target_worksheet
End Sub
you don't need all that variable dimming and assigning:
Sub workBooks()
ThisWorkbook.Sheet2.Copy After:=ActiveWorkbook.Sheets(7)
End Sub
I need to take a spreadsheet and compare it with a spreadsheet from another workbook. I know that I can do this using VBA, but I will need to copy a spreadsheet from another workbook so that both spreadsheets will reside within the same workbook and be accessible for comparison. How do I copy a spreadsheet from one workbook into another using VBA?
You don't need to copy the worksheets over to compare them. Simply open both WorkBooks and and set reference to there WorkSheets.
Sub CompareWorkBooks()
Dim wbPending As Workbook
Dim wsPending As Worksheet
Set wbPending = Workbooks("Items Pending")
Set wsPending = wsPending.Worksheet("Items")
Dim wbRecieved As Workbook
Dim wsRecieved As Worksheet
Set wbRecieved = Workbooks("Items Recieved")
Set wsRecieved = Worksheet("Items")
End Sub
If you provide names for Workbooks & WorkSheets and provide column information, we can give you better answers in a shorter period of time. Don't be afraid to post your code either.
If you want a user to select the target workbook and worksheet:
Create a userform
Declare targetWorkbook and tartgetWorksheet at the top of the code module
Add a command button and a combo box
When the button is clicked a file dialog is opened
A reference is now set to the open file
The names of all the worksheets are added to the combo
Changing the combo box value will set the refernce to tartgetWorksheet
Option Explicit
Public targetWorkbook As Workbook
Public tartgetWorksheet As Worksheet
Private Sub CommandButton1_Click()
Dim targetWorkbook As Workbook
Dim ws As Worksheet
Set targetWorkbook = getTargetWorkbook
If targetWorkbook = Nothing Then
MsgBox "Sowmthing went wrong", vbCritical, "Try Again"
Else
For Each ws In targetWorkbook.Worksheets
ComboBox1.AddItem ws.Name
Next
End If
End Function
Function getTargetWorkbook() As Workbook
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.Show
On Error Resume Next
Set getTargetWorkbook = Application.Workbooks.Open(.SelectedItems(1))
On Error GoTo 0
End With
End Function
Private Sub ComboBox1_Change()
Set tartgetWorksheet = targetWorkbook.Worksheets(ComboBox1.Value)
End Sub
I would like my code to open a workbook (always the same one), detect the first free row, write to just two cells in that row, and then save/close the workbook. This seems like a simple problem, but the macro seems to be opening a copy of the file, and then locking it for editing.
Can you see any errors in my open code? I know that the file opens and that the row search works, but then it 1. never writes to the cells, and 2. locks the file.
Function WriteToMaster(Num, Path) As Boolean
'Declare variables
Dim xlApp As Excel.Application
Dim wb As Workbook
Dim ws As Worksheet
Dim infoLoc As Long
Set xlApp = New Excel.Application
'Specifies where the Master Move Key is stored
Set wb = xlApp.Workbooks.Open("DOC LOCATION")
Set ws = wb.Worksheets("Sheet1")
'Loop through cells, looking for an empty one, and set that to the loan number
infoLoc = firstBlankRow(ws)
MsgBox "First blank row is " & infoLoc & ". Num is " & Num
ws.Cells(infoLoc, 1).Value = Num
ws.Cells(infoLoc, 2).Value = Path
'Save, close, and quit
wb.Save
wb.Close
xlApp.Quit
'Resets the variables
Set ws = Nothing
Set wb = Nothing
Set xlApp = Nothing
'pieces of function from http://p2p.wrox.com/vb-how/30-read-write-excel-file-using-vb6.html
End Function
Thank you again, stackoverflow <3
Do you need to open a new excel app just to open a workbook?
Can't you just do something like this:
Sub Macro1()
Dim wkb As Workbook
Workbooks.Open Filename:="\User Documents$\bob\My Documents\workbook_open_example.xlsx"
Set wkb = Workbooks("workbook_open_example.xlsx")
End Sub