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
Related
I want to be able to select a workbook and then copy the content from that workbook (sheet 1) into my current active workbook where I run the macro. I've been looking at some answers here on StackOverflow to similar questions and got the following code (see below).
The selection of a file is currently working fine, but when I run the macro it throws an error
Runtime error "438": Object does not support that method or property`
(please note, that the error comes in my native language and is just translated by me)
Sadly no object is marked that he relates to, so I can't really make out what problem he has. Yet, I guess it is a problem with the PasteSpecial in the last line of function GetTemplateData, but that code should be alright (what is it supposed to do? Save the data into the first sheet of the give workbook activeWorkbook) and pass the reference back go GeneratedValues-routine.
Option Explicit
Private Sub GenerateValues()
'Application.ScreenUpdating = False
'Application.DisplayAlerts = False
Dim activeWorkbook As Workbook
Dim activeWorksheet As Worksheet
Set activeWorkbook = Application.activeWorkbook
Set activeWorksheet = GetTemplateData(activeWorkbook)
activeWorkbook.Save
End Sub
'Get The Template Data
Private Function GetTemplateData(activeWorkbook As Workbook) As Worksheet
Dim templateWorkbook As Workbook
'Grab the Template Worksheet
Set templateWorkbook = UseFileDialogOpen
'Select all Content
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Copy
'activeWorkbook.Sheets(activeWorkbook.Sheets.Count).Range("A1", Cells.End(xlDown) & Cells.End(xlRight)).PasteSpecial xlPasteValues
activeWorkbook.Sheets(1).Range("A1", Cells.End(xlDown) & Cells.End(xlRight)).PasteSpecial xlPasteValues
End Function
'From https://learn.microsoft.com/de-de/office/vba/api/excel.application.filedialog
'Select the Workbook containing the Exported Template-Stories by User Selection
Function UseFileDialogOpen() As Workbook
Dim lngCount As Long
Dim filePath As String
Dim templateBook As Workbook
' Open the file dialog
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.Show
Set templateBook = Workbooks.Open(.SelectedItems(1))
' Display paths of each file selected
'For lngCount = 1 To .SelectedItems.Count
' MsgBox .SelectedItems(lngCount)
'Next lngCount
End With
templateBook
End Function
I believe all of your problems originate here:
Private Sub GenerateValues()
'Application.ScreenUpdating = False
'Application.DisplayAlerts = False
Dim activeWorkbook As Workbook
Dim activeWorksheet As Worksheet
Set activeWorkbook = Application.activeWorkbook
Set activeWorksheet = GetTemplateData(activeWorkbook)
activeWorkbook.Save
End Sub
ActiveWorkbook is a defined "variable" in VBA, so it is confused as to why you are trying to reassign it. Try using a different variable name instead.
Note: although ActiveWorksheet is not a defined variable in VBA, it is close in name to ActiveSheet, so I would also change that variable name to something different just so to not confuse you when writing future code.
You could try something similar to this:
Sub CopyContentsFromOtherWorkbook()
Dim wb As Workbook
Dim twb As Workbook
filePath = "C:\File.xlsx"
Set wb = Workbooks.Open(filePath)
wb.Sheets(1).Range("A1:Z10000").Copy
Set twb = ThisWorkbook
twb.Sheets(1).Range("C1").PasteSpecial xlPasteValues
wb.Close
twb.Save
End Sub
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
I'm working on a macro that will move a sheet from a selected Excel sheet into a document with a macro already loaded.
I'm having issues with actually getting the sheet to move over, I keep receiving a subscript out of range error and I'm unsure of why
I've perused stackoverflow and a few other resources so far. I've attempted using .sheets / workbook(workbookname).worksheets(1).copy ...so on and so forth.
Sub runEXCEL()
dim wb1 as workbook, wb2 as workbook
dim fd as filedialog
dim shtpath as string
dim ws as worksheet
Set fd = Application.FileDialog(msoFileDialogFilePicker)
If fd.Show = True Then
If fd.SelectedItems(1) <> vbNullString Then
shtpath = fd.SelectedItems(1)
End If
Else
End
End If
set wb1 = workbooks.open("c:\users\username\documents\yestbook.xlsm", true, false
set wb2 = workbooks.open(shtpath)
set ws = wb2.worksheets(1)
ws.name = "testname"
ws.worksheets(1).copy after:=wb1.sheets(1)
'xl.Application.Run "yestbook.xlsm!findCellAddress"
End Sub
Ideally I would like to copy a sheet from a selected workbook into my predefined workbook.
Subscript out of range occurs because "yestbook.xlsm" does not exist in the global Workbooks collection, which is in this case limited to the active instance of Excel (i.e., the instance from which this code is executed). You've opened two workbooks, each in a new and separate instance of Excel, which presents further problems, because you can't actually Copy worksheets between instances like this.
This should work, unless there are some extraordinary reasons why each file must open in its own instance:
Dim wb1 As Workbook, wb2 as Workbook
Dim fd As FileDialog
Dim shtpath As String
Dim ws As Worksheet
Set fd = Application.FileDialog(msoFileDialogFilePicker)
If fd.Show = True Then
If fd.SelectedItems(1) <> vbNullString Then
shtpath = fd.SelectedItems(1)
End If
Else
End
End If
Set wb1 = Workbooks.Open("C:\Users\username\Desktop\yestbook.xlsm", True, False)
Set wb2 = Workbooks.Open(shtpath)
Set ws = wb2.Worksheets(1)
ws.Name = "testname"
ws.Copy after:=wb1.Sheets(1)
It is not necessary to create additional Excel processes (actually, this might be cause of the problem). You should also use workbook and worksheets variables for all sheet access, and avoid unqualified access like Sheets("testname").
Try something along the lines of:
Dim wb as workbook, ws as worksheet, wb2 as workbook, ws2 as worksheet
Set wb = Workbooks.Open(mysheetpath1)
Set ws=wb.Worksheets(1)
set wb2=Workbooks.Open(mysheetpath2)
set ws2=wb2.Worksheets(1)
ws2.Copy after:=ws
Second to last line - you have
ws.worksheets(1).copy after:=wb1.sheets(1)
This should be
wb.worksheets(1).copy after:=wb1.sheets(1)
it's a typo on the second char
I'm trying to delete a worksheet from MS Access.
There's a lot of data on the sheet, including two charts. Instead of trying to delete all the data, I want to delete the sheet and re-add it.
I've looked up several ways to delete a sheet with MS Access and found the following .delete as the easiest, but it doesn't work. The "if not" works and goes through the .delete statement, but the .add(after...) fails.
I obviously have something wrong and any input is appreciated.
Dim wkb as excel.workbook
Dim wksheetname as excel.worksheet
Dim strsheetname as string
wkb.Activate
On Error Resume Next
Set wksSheetName = wkb.Sheets(StrSheetName)
On Error GoTo 0
If Not wksSheetName Is Nothing Then
wkb.Sheets(StrSheetName).Delete
Set wksSheetName = Nothing
End If
wkb.Sheets.Add(After:=wkb.Sheets(wkb.Sheets.Count)).Name = StrSheetName
Set wksSheetName = wkb.Sheets(StrSheetName)
This somewhat simpler method works here:
Const WorksheetName As String = "Sheet2"
Dim Workbook As Excel.Workbook
Dim Worksheet As Excel.Worksheet
Set Workbook = ThisWorkbook
For Each Worksheet In Workbook.Worksheets
If Worksheet.Name = WorksheetName Then
Worksheet.Delete
Exit For
End If
Next
Set Worksheet = Workbook.Worksheets.Add(After:=Workbook.Worksheets(Workbook.Worksheets.Count))
Worksheet.Name = WorksheetName
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...