I'm trying to copy a range of values from a workbook to another by using a dialog box to select the file I'd like to copy the data from.
I'd like also not to open the "copyFrom" workbook in the process. The problem lies in passing the file path in the string "filename" to the workbook variable "copyFrom".
Option Explicit
Private Sub butt_copy_Click()
Call copy1
End Sub
Private Sub copy1()
Dim fileName As String, copyFrom As Workbook
fileName = Application.GetOpenFilename()
copyFrom = filename
Sheet1.Range("A1:A20") = copyFrom.Sheets(Sheet1).Range("A1:A20")
End Sub
Just a comment to add to the algorithm;
It opens the file and reads from it, but does not close. This makes it "READ_ONLY" for all other users!
I suggest that at the end of the code: add this for saving original file unchanged.
Application.DisplayAlerts = False
app.Workbooks.Close savechanges:=False
Application.DisplayAlerts = True
Try Below. But i have some Clarification like where will you run the code from
Application.Visible=False
Set copyFrom = Application.Workbooks.Open(fileName)
Then Try below. Worked Perfectly for me
Private Sub copy1()
Dim app As New Excel.Application
Dim fileName As String, copyFrom As Workbook
app.Visible = False
fileName = app.GetOpenFilename()
Set copyFrom = app.Workbooks.Open(fileName)
MsgBox copyFrom.Sheets(1).Cells(1, 1)
'Sheet1.Range("A1:A20") = copyFrom.Sheets(Sheet1).Range("A1:A20")
End Sub
Related
I would like to browse to the specific excel file and copy sheet1 of the file which is opening into the new sheet in my xlsm file. I have written the code like below:
Option Explicit
Sub test_copy_sheet()
Dim path As String
Dim filetoopen As Variant
Dim openwb As Workbook
filetoopen = Application.GetOpenFilename()
If filetoopen <> False Then
Set openwb = Application.Workbooks.Open(filetoopen)
openwb.Sheets(1).Copy
ThisWorkbook.Sheets.Add.Name = "mysheet"
ThisWorkbook.Sheets("mysheet").PasteSpecial xlPasteValues
openwb.Close False
End If
End Sub
When i ran the code, it get the issue as photo
I just want to copy sheet1 of the file opening to sheet name "mysheet". Could you please assist on this ?
As mentioned in the comments, please insert Option Explicit at the top of the module to ensure you declare all variables properly (and also pick up typo like thisworkbook and OpenBook)
Try this code below, it will open the file, copy the first sheet to ThisWorkbook and rename to mysheet:
Sub test_copy_sheet()
Dim filetoopen As Variant
Dim openwb As Workbook
filetoopen = Application.GetOpenFilename()
If filetoopen <> False Then
Set openwb = Application.Workbooks.Open(filetoopen, ReadOnly:=True)
openwb.Sheets(1).Copy ThisWorkbook.Sheets(1)
ThisWorkbook.Sheets(1).Name = "mysheet"
openwb.Close
End If
End Sub
Note: You will need to add additional check to be sure that ThisWorkbook does not have a sheet named mysheet. (i.e. no duplicate names)
I have some VBA script in one Excel Workbook that has three subs that each either read from a second Workbook. Each of the subs uses the following algorithm (simplified to distill the interaction with the second book):
Public Sub EditRemote()
Dim remoteDataSheet As Worksheet
Dim source As String 'Source worksheet name
Dim target As String 'Target worksheet name
Dim path As String
Dim wkbName As String
source = "CountData"
path = ThisWorkbook.Worksheets("Parameters").Range("B2").Value
wkbName = ThisWorkbook.Worksheets("Parameters").Range("A2").Value
target = "CountData"
Application.EnableCancelKey = xlDisabled
Set localDataSheet = ThisWorkbook.Sheets(source)
If Not WorkbookIsOpen(wkbName) Then
Workbooks.Open (path)
End If
Set remoteDataSheet = Workbooks(wkbName).Sheets(source)
remoteDataSheet.Cells(1,1) = localDataSheet.Cells(1,1)
remoteDataSheet.Cells(1,2) = localDataSheet.Cells(1,2)
Workbooks(wkbName).Close SaveChanges:=True
End Sub
Function WorkbookIsOpen(targetWorkbook As String) As Boolean
Dim testBook As Workbook
On Error Resume Next
Set testBook = Workbooks(targetWorkbook)
If Err.Number = 0 Then
WorkbookIsOpen = True
Else:
WorkbookIsOpen = False
End If
End Function
There is also a pivot table in this Workbook that draws its data from the second file though an external data connection as well. The issue that is plaguing me is that it seems that not initially but after a few operations, these subs stop making the edits properly and instead it opens a read only copy of the second Workbook. When I try to open the second workbook manually I get a message saying that the file is already open and is locked for editing. Right now both files are local to my computer and couldn't be opened by anyone else. What am I missing to be sure that I can make the code work as intended?
I made some modification to your code, ran it a few times, and didn't get your "Read-only" message.
In your code the line of declaring localDataSheet is missing, added Dim localDataSheet As Worksheet , also added Dim remoteWb As Workbook for the remote workbook.
(didn't modify your Funtion WorkbookIsOpen code).
Sub EditRemote Code
Option Explicit
Public Sub EditRemote()
Dim remoteDataSheet As Worksheet
Dim localDataSheet As Worksheet
Dim source As String 'Source worksheet name
Dim target As String 'Target worksheet name
Dim path As String
Dim wkbName As String
Dim remoteWb As Workbook
source = "CountData"
path = ThisWorkbook.Worksheets("Parameters").Range("B2").Value
wkbName = ThisWorkbook.Worksheets("Parameters").Range("A2").Value
target = "CountData"
Application.EnableCancelKey = xlDisabled
Set localDataSheet = ThisWorkbook.Sheets(source)
' check if workbbok already open
If Not WorkbookIsOpen(wkbName) Then
Set remoteWb = Workbooks.Open(path)
Else
Set remoteWb = Workbooks(wkbName) ' workbook is open >> set remoteWb accordingly
End If
Set remoteDataSheet = remoteWb.Sheets(source)
remoteDataSheet.Cells(1, 1) = localDataSheet.Cells(1, 1)
remoteDataSheet.Cells(1, 2) = localDataSheet.Cells(1, 2)
Workbooks(wkbName).Close SaveChanges:=True
End Sub
Just to verify the data in your Excel "Parameters" sheet, the screen-shot below shows the data I used for my testing.
Cell A2 contains the "Clean" workbook name.
Cell B2 contains workbbok "full" name - path + "clean" workbook name.
After some further testing to diagnose the issue, I found that there was nothing wrong with the VBA code, but rather the external data connection to the remote Workbook was locking that Workbook every time I refreshed the data in the pivot table that used the external data connection as its source. It isn't unlocking the file when it is done refreshing, and that leaves the file locked until I close the Workbook with the pivot table. Now I just need to solve that problem.
I am trying to open and copy the sheet data from a CSV file and paste it in another workbook but I am getting run time error 9 - Subscript out of range.
Option Explicit
Sub import()
Dim filename As String
Dim curfilename As String
curfilename = ThisWorkbook.Path
filename = Application.GetOpenFilename
Application.ScreenUpdating = False
Dim x As Workbook
Set x = Workbooks.Open(filename)
Workbooks(filename).Sheets("Owners").Range("A1:Z10000").Copy 'Error on this line
Workbooks(curfilename).Sheets("Owners").Range("A1:Z10000").Paste
'Close x:
x.Close
End Sub
The Application.GetOpenFilename method returns the full path and file name including extension. You only want the filename with extension if referring to an open workbook; not the path as well.
The Worksheet.Paste does not work that way but the Range.PasteSpecial method does. Change your code to be,
Dim Filename As String, currFilename As String
Dim x As Workbook
Application.ScreenUpdating = False
currFilename = ThisWorkbook.Name
Filename = Application.GetOpenFilename
Set x = Workbooks.Open(Filename)
x.Sheets("Owners").Range("A1:Z10000").Copy
Workbooks(currFilename).Sheets("Owners").Range("A1").PasteSpecial
Application.DisplayAlerts = False
x.Close SaveChanges:=False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
I've corrected a few small errors in variable assignment (.Path should have been .Name) and added some environment control to avoid silly warning messages.
Alternately, the Range.Copy method could be used and you would provide the destination directly as a parameter.
x.Sheets("Owners").Range("A1:Z10000").Copy _
Destination:=Workbooks(curfilename).Sheets("Owners").Range("A1")
Note that only the top-left cell in a range is necessary to specify the target of a paste operation.
I'm trying to run a VBA macro through .VBS file(File name: Check_final.vbs). Here is the code
Option Explicit
run_macro
Sub run_macro()
Dim xl1
Dim sCurPath
Dim xlBook
Dim FolderFromPath
Set xl1 = CreateObject("Excel.application")
sCurPath =Wscript.ScriptFullName
Set xlBook = xl1.Workbooks.Open(sCurPath, 0, True)
xl1.DisplayAlerts = False
FolderFromPath = Left(sCurPath, InStrRev(sCurPath, "\"))
xl1.Application.run FolderFromPath & "Changed_chk.xlsm!Check"
Set xlBook = Nothing
End Sub
When I run this .vbs file I get this popup 'Changed_chk.xlsm is locked for editing' with Read only and notify options. If I acknowledge it with either Read only or notify option a excel sheet is opened in the name of Check_final (which is the file name of that .vbs file) and the above mentioned code is shown written in that excel file. Then I get a Windows script host error(code: 800A03AC) saying macro may not be available or all macro's are disabled.(Though I have enabled the macro as mentioned here.[http://www.addictivetips.com/windows-tips/enable-all-macros-in-excel-2010/)].
Any help on this is much appreciated. Thanks in advance.
You open your vbs-file instead of your excel-file... Also make sure that your function/sub is public. In the example below, I created a Public Sub Check in the module "YourModuleName", which I call from the vbs-file.
Option Explicit
run_macro
Sub run_macro()
Dim xl1
Dim xlBook
Dim FolderFromPath
Set xl1 = CreateObject("Excel.application")
FolderFromPath = Replace(WScript.ScriptFullName, WScript.ScriptName, "")
set xlBook = xl1.Workbooks.Open(FolderFromPath & "Changed_chk.xlsm")
xl1.Application.run "'" & xlBook.Name & "'!YourModuleName.Check"
xl1.Application.Quit
End Sub
Try this simple code (UNTESTED)
Dim oXlApp, oXLWb, sCurPath
Set oXlApp = CreateObject("Excel.application")
sCurPath = Replace(WScript.ScriptFullName, WScript.ScriptName, "")
Set oXLWb = oXlApp.Workbooks.Open(sCurPath & "Changed_chk.xlsm")
oXlApp.DisplayAlerts = False
oXlApp.Run "Check"
'~~> Close the file here. Save or discard the changes as per your requirement
'oXLWb.Close (True)
'oXLWb.Close (False)
oXLWb.Close
oXlApp.Quit
Set oXLWb = Nothing
Set oXlApp = Nothing
Also where is your macro? In a sheet or in a module? You may want to see THIS
I think there may be something wrong with calling the run_macro statement. From the test i created in excel VBA there is an error if i try to call the sub outside of another sub
Option Explicit
test
Sub test()
MsgBox ("Test")
End Sub
I think you may want to
Option Explicit
Sub Start
run_macro
End Sub
Sub run_macro()
'code here
End Sub
or remove the run_macro line altogether?
I want to open and refer to a workbook via the function below. Only the function produces the run-time error '91': object variable or with block variable not set just before jumping back into the main code.
When I put the exact code (just not as function) into my main code it works perfectly.
But I don't want to have the whole function in my main code because I think it's unnecessary and ugly.
Maybe someone can help me make my code nicer and better comprehensible!
Thank you already!
This is the relevant part of my main sub:
Sub main_sub()
Dim WBtest As Workbook
Dim WBpath As String
WBpath = ThisWorkbook.Sheets("Control").Range("A6").Value 'read path
WBtest = openfile(WBpath) 'I call my function here
End Sub
This is the function that produces the error
The function is supposed to return the (newly) opened workbook
Public Function openfile(path As String) As Workbook 'path is fullpath
Dim wb As Workbook
Dim alreadyopen As Boolean
For Each wb In Workbooks 'loop over all Workbooks
If wb.FullName = path Then 'check if file is already open
alreadyopen = True
Set openfile = wb
End If
Next wb
If alreadyopen = False Then
'file not yet opened --> open it
Set openfile = Workbooks.Open(path)
End If
'MsgBox openfile.name 'this returns the right name
End Function
When I write all of it in my main sub it works (but is ugly, so I don't want it there!)
This works:
Sub main_sub()
Dim WBtest As Workbook
Dim WBpath As String
Dim wb As Workbook 'for loop
Dim alreadyopen As Boolean
WBpath = ThisWorkbook.Sheets("Control").Range("A6").Value 'read path
For Each wb In Workbooks 'loop over all Workbooks
If wb.FullName = WBpath Then
alreadyopen = True
Set WBtest = wb
End If
Next wb
If alreadyopen = False Then
'file not yet opened --> open it
Set WBtest = Workbooks.Open(WBpath)
End If
End Sub
I have a similar problem later in my code, where I want to have a function return a workbook, too. So this seems to be the problem.
How does a function return a workbook?
I have found similar functions returnins worksheets. Those work. Why not with workbooks?
Thank you so much for your help!
The different between both approaches is that, in the first one, you are forgetting the Set bit. Thus, solution:
Set WBtest = openfile(WBpath) 'I call my function here