I'm writing a VBA code to
1. open file;
2. copy sheet and paste onto current workbook;
3. close source workbook.
Everything works fine till point number 3, where I get the Run-time error 4244 object required.
If you look at the code below, I believe the problem lies with "wb.close". I could use some help here!
New excel vba guy here trying to be more efficient
Sub ImportOriginated()
Dim fileNameAndPath As Variant
Dim SrcWbk As Workbook
fileNameAndPath = Application.GetOpenFilename(Title:="Select Origination File To Be Opened")
If fileNameAndPath = False Then Exit Sub
Workbooks.Open Filename:=fileNameAndPath
Worksheets("LoanBookLocalCurrencyfilteredby").Activate
ActiveSheet.Copy After:=Workbooks("Portfolio Reporting
Dashboard.xlsm").Sheets(Workbooks("Portfolio Reporting
Dashboard.xlsm").Worksheets.Count)
wb.Close
End Sub
The source file which I've copied from should close.
You need to Set your object before you can use it! If you add Option Explicit to the top of your code, VBA will be kind enough to notify you of mistakes like this
Option Explicit
Sub Revision()
Dim wb As Workbook
Dim ws As Worksheet
Dim fn As String
Dim Temp As Workbook
fn = Application.GetOpenFilename(Title:="Select Origination File to be Opened")
If fn <> "" Then
Set wb = Workbooks.Open(fn)
Set ws = wb.Sheets("LoanBookLocalCurrencyfilterdby")
Set Temp = Workbooks("Portfolio Reporting Dashboard.xlsm")
ws.Copy After:=Temp.Sheets(Temp.Sheets.Count)
wb.Close
End If
Problem:
No allocation of wb
No allocation of SrcWbk
Extra " in counting worksheets
Try:
Sub ImportOriginated()
Dim fileNameAndPath As Variant
Dim SrcWbk As Workbook
Dim num As Integer
fileNameAndPath = Application.GetOpenFilename(Title:="Select Origination File To Be Opened")
If fileNameAndPath = False Then Exit Sub
Set SrcWbk = Workbooks.Open(fileNameAndPath)
num = Workbooks("Portfolio Reporting Dashboard.xlsm").Worksheets.Count
Worksheets("LoanBookLocalCurrencyfilteredby").Copy After:=Workbooks("Portfolio Reporting Dashboard.xlsm").Sheets(num)
SrcWbk.Close False
End Sub
Related
I use the code below to write the names of the workbooks open in Microsoft Excel in an array, but it does not return the name of a freshly open excel file that was generated from SQL Server using template file (.xltm), knowing that the user account is a domain user. So, is it because of template or the domain user account? and how can I solve this problem and get the name of such file?
For Each AWB In Application.Workbooks
If AWB.Name <> ThisWorkbook.Name Then
WB_Array(i) = AWB.Name
i = i + 1
End If
Next AWB
Thanks
Extending the great answer in the link that Tim Williams gave in the comments, if the issue is that the other workbook is open in a different instance of Excel, you won't be able to find it by just looking in Application.Workbooks. You will need to get all the open Excel.Application Objects and then check each of their Application.Workbooks collections.
Credit to Florent B. for their code. Add their code to your project. Then use the following function to collect each workbook into a Dictionary. I have included an example of how to use that function to collect all the workbook names into an array.
Sub Example()
Dim AllWorkbooks As Object
Set AllWorkbooks = GetAllWorkbooks
'AllWorkbooks.Keys() is now an array containing the names of all open workbooks
'AllWorkbooks.Items() is now an array of all open workbook objects
End Sub
Function GetAllWorkbooks() As Object
Dim xlWorkbooks As Object
Set xlWorkbooks = CreateObject("Scripting.Dictionary")
Dim xl As Application
For Each xl In GetExcelInstances()
Dim WB As Workbook
For Each WB In xl.Workbooks
If Not xlWorkbooks.Exists(WB.Name) Then xlWorkbooks.Add WB.Name, WB
Next
Next
Set GetAllWorkbooks = xlWorkbooks
End Function
Open Workbooks to Array
Option Explicit
Sub ListWorkbookNames()
Dim wbCount As Long: wbCount = Workbooks.Count
If wbCount = 1 Then
MsgBox "Only the workbook containing this code is open.", vbExclamation
Exit Sub
End If
Dim WorkbookNames() As String: ReDim WorkbookNames(1 To wbCount - 1)
Dim wb As Workbook
Dim n As Long
For Each wb In Workbooks
If Not wb Is ThisWorkbook Then
n = n + 1
WorkbookNames(n) = wb.Name
End If
Next wb
MsgBox "Found the following open workbooks:" & vbLf _
& Join(WorkbookNames, vbLf), vbInformation
End Sub
I have a template, that I copy data into, then suse SaveCopyAs to save it down in a different location. I want to start adding a it each time. However all that happens is it saves it down in new location without password.
Attached below is the code, the reason I use the extra (unnecessary) .Open is due to the fact I could not find a way to do it just using SaveCopyAs
Option Explicit
Sub SaveCopyAs_password()
Dim passdate As String
Dim wb, wbresults As Workbook
passdate = "hello"
Workbooks.Open ("R:\Macros\pre\Mealplan.xlsx")
Set wbresults = Workbooks("Mealplan")
wbresults.SaveCopyAs ("R:\Macros\post\Mealplan.xlsx")
Workbooks.Open ("R:\Macros\post\Mealplan.xlsx")
Workbooks("Mealplan.xlsx").Activate
Set wb = ActiveWorkbook
ActiveWorkbook.SaveAs Password:=passdate
wb.Close
End Sub
This Simple code will work for you:
Sub SaveCopyAs_password()
Dim passdate As String
Dim wbresults As Workbook
passdate = "hello"
FileCopy "R:\Macros\pre\Mealplan.xlsx", "R:\Macros\post\Mealplan.xlsx"
Set wbresults = Workbooks.Open("R:\Macros\post\Mealplan.xlsx")
wbresults.SaveAs Password:=passdate
wbresults.Close
End Sub
Another Way:
Sub SaveCopyAs_password()
Dim passdate As String
Dim wbresults As Workbook
passdate = "hello"
Set wbresults = Workbooks.Open("R:\Macros\pre\Mealplan.xlsx")
wbresults.SaveAs Filename:="R:\Macros\post\Mealplan.xlsx", Password:=passdate
wbresults.Close
End Sub
Run this Macro from any other workbook other than the 2 used in Macro.
Workbooks.Open "C:\abc.xlsx"
Workbooks("abc").Worksheets("Sheet1").Range("A1:B7").Clear
In the above code I am opening the workbook using Workbooks.Open in first line. In the second line I am accessing the opened workbook using the workbook name.
How can I access the opened workbook without the filename in second line?
(I want to create a function and I don't want to pass both the file paths and filenames separately)
You need to use references and reference the workbook and the sheet for example:
Option Explicit
Sub OpenWorkbook()
Dim wb As Workbook, ws As Worksheet
Set wb = Workbooks.Open("C:\abc.xlsx", UpdateLinks:=False, ReadOnly:=True)
Set ws = wb.Sheets("Sheet1")
ws.Range("A1:B7").ClearContents
End Sub
Note that the parameters on the openworkbook such as Updatelinksand ReadOnly can be modified to True or Falseas you need to.
Create an object of type Excel.Workbook and open the workbook into that.
Like so
Dim w as Excel.Workbook
set w= Workbooks.Open ("C:\abc.xlsx")
and then you can say
w.worksheets.add.....
etc
You can shorten your code:
Option Explicit
Sub OpenWb()
Dim ws As Worksheet
Set ws = Workbooks.Open("C:\abc.xlsx").Worksheets("Sheet1")
With ws '<- Use With Statement to avoid sheet repetition
.Range("A1:B7").ClearContents
End With
End Sub
You can try this
Option Explicit
Sub TEST()
Dim WB As Workbook
Set WB = Workbooks.Open(Filename:="C:\abc.xlsx")
For Each WB In Workbooks
If WB.Name = "abc.xlsx" Then
WB.Worksheets(Sheet1).Range("A1:B7").ClearContents
Exit Sub
End If
Next
End Sub
I have multiple workbooks with worksheet named 'SUMMARY-F'. I need to combine these worksheets into one workbook and I am using the below code:
Sub CopySheets1()
Dim wkb As Workbook
Dim sWksName As String
sWksName = "SUMMARY-F"
For Each wkb In Workbooks
If wkb.Name <> ThisWorkbook.Name Then
wkb.Worksheets(sWksName).Copy _
Before:=ThisWorkbook.Sheets(1)
End If
Next
Set wkb = Nothing
End Sub
The code worked perfectly about 4 times however now when I run it, I get a subscript out of range error 9. Any tips on how to fix this?
Thanks,
Lucinda
If you have a workbook that is open that doesn't contain a sheet called SUMMARY-F you'll get an out-of-range error because Excel can't find a sheet with the specified name. This error will also apply to hidden workbooks such as a PERSONAL.xlsm if you've used it to record macros.
You should include a check in your code to handle the case when an open workbook doesn't have a sheet called SUMMARY-F.
See this question that gives options on how to identify if a sheet exists, such as defining a function that could be called from your code first:
How to check whether certain sheets exist or not in Excel-VBA?
You'll just need to modify it to check a sheet in another workbook, something like:
Public Function CheckSheet(ByVal sWB As String, ByVal sSheetName As String) As Boolean
Dim oSheet As Excel.Worksheet
Dim bReturn As Boolean
For Each oSheet In Workbooks(sWB).Sheets
If oSheet.Name = sSheetName Then
bReturn = True
Exit For
End If
Next oSheet
CheckSheet = bReturn
End Function
Then you can add a check in your code:
Sub CopySheets1()
Dim wkb As Workbook
Dim sWksName As String
sWksName = "SUMMARY-F"
For Each wkb In Workbooks
If wkb.Name <> ThisWorkbook.Name Then
If CheckSheet(wkb.Name,sWksName)
wkb.Worksheets(sWksName).Copy Before:=ThisWorkbook.Sheets(1)
End If
End If
Next
Set wkb = Nothing
End Sub
A "Runtime Error 9, Subscript Out of Range" is received on the Set wb1 line. This similar structure runs fine in a different workbook without error.
My goal is to copy a cell from the Source document into te Destination document.
Sub CopySheetsl()
Dim wb As Workbook, wb1 As Workbook
Dim LastRow As Long
Set wb = Workbooks("C:\Test\DST.xlsm")
Set wb1 = Workbooks.Open("C:\Test\Source.xlsx")
wb1.Sheets("SourceNamedSheet").Range("A1") = wb.Sheets("DestinationNamedSheet").Range("A1").Value
wb1.Close
End Sub
If DST.xlsm is open already then
Set wb = Workbooks("DST.xlsm")
ElseIf you need to open DST.xlsm
Set wb1 = Workbooks.Open("C:\Test\DST.xlsm")
for a more robust approach to workbooks handling you may want to use the following GetOrSetWorkbook() function:
Option Explicit
Function GetOrSetWorkbook(wbName As String) As Workbook
On Error Resume Next
Set GetOrSetWorkbook = Workbooks(GetNameOnly(wbName)) '<--| check if a workbook with given name is already open
If GetOrSetWorkbook Is Nothing Then Set GetOrSetWorkbook = Workbooks.Open(wbName) '<--| if no workbook open with given name then try opening it with full given path
End Function
which uses the following helper GetNameOnly() function:
Function GetNameOnly(pathStrng As String) As String
Dim iSlash As Long
iSlash = InStrRev(pathStrng, "\")
If iSlash > 0 Then
GetNameOnly = Mid(pathStrng, iSlash + 1, Len(pathStrng))
Else
GetNameOnly = pathStrng
End If
End Function
so that a possible use of it could be:
Option Explicit
Sub CopySheetsl()
Dim wb As Workbook, wb1 As Workbook
Dim LastRow As Long
Set wb = GetOrSetWorkbook("C:\Test\DST.xlsm") '<--| try getting "C:\Test\DST.xlsm"
If wb Is Nothing Then '<--| if unsuccessful...
'... code to handle C:\Test\DST.xlsm workbook error, like:
MsgBox "Couldn't find 'C:\Test\DST.xlsm' !", vbCritical + vbOKOnly
End If
Set wb1 = GetOrSetWorkbook("C:\Test\Source.xlsx") '<--| try getting "C:\Test\Source.xlsx
If wb Is Nothing Then '<--| if unsuccessful...
'... code to handle 'C:\Test\Source.xlsx' workbook error, like:
MsgBox "Couldn't find 'C:\Test\Source.xlsx'!", vbCritical + vbOKOnly
End If
'here goes rest of the code to be executed once all necessary workbooks have been properly set
wb1.Sheets("SourceNamedSheet").Range("A1") = wb.Sheets("DestinationNamedSheet").Range("A1").Value
wb1.Close
End Sub
of course a very similar GetOrSet approach can be assumed with worksheets, too...