I am trying to reference two different workbook in two different variables but they are not working as it should be
Ex:
dim TrgWb as workbook
dim SrcWb as workbook
dim TrgSh as worksheet
dim SrcSh as worksheet
Set TrgWb = Workbooks.Open("C:\Users\us\Documents\test1.xlsx")
Set TrgSh = TrgWb.Sheets(1)
Set SrcWb = Workbooks.Open("C:\Users\us\Documents\History\test2.xls")
Set SrcSh = SrcWb.Worksheets(1)
so object [ Trgwb ] should refer to test1.xlsx and object [ SrcWb ] refer to test2.xls
but actually what is happening is both of them referring to test2.xls
I don't know where is my mistake
Thanks In Advance
Sayed
Before opening either of the workbooks you need to first test whether they're already open. Otherwise there's a risk TrgWb and/or SrcWb will be assigned to the wrong workbook.
...basically if you call (eg) Set wb = workbooks.open(pathHere) and the workbook is already open, you get back a reference to the last-opened workbook, which may be the wrong one.
You could modify your code like this:
Sub Tester()
Dim TrgWb As Workbook, SrcWb As Workbook
Dim TrgSh As Worksheet, SrcSh As Worksheet
Set TrgWb = GetWorkbook("C:\Users\us\Documents\", "test1.xlsx")
Set TrgSh = TrgWb.Sheets(1)
Set SrcWb = GetWorkbook("C:\Users\us\Documents\History\", "test2.xls")
Set SrcSh = SrcWb.Worksheets(1)
End Sub
'get a reference to a workbook which may already be open
'Note: does not check if the already-open wb has the same path as `path`
Function GetWorkbook(path As String, wbName As String) As Workbook
Dim wb As Workbook
On Error Resume Next 'ignore error if wb not open
Set GetWorkbook = Workbooks(wbName)
On Error GoTo 0 'stop ignoring errors
If GetWorkbook Is Nothing Then
If Right(path, 1) <> "\" Then path = path & "\"
Set GetWorkbook = Workbooks.Open(path & wbName)
End If
End Function
Related
I have been regularly running a macro, and now it is not working. The part I am having trouble with is defining the worksheet as a first worksheet of a workbook, (which I have previously defined).
It's telling me wbCopy.Sheets(1) object variable not set. the last line is giving me the error.
Dim wbCopy As Workbook
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim wsName As String
Set wbCopy = Workbooks.Open(Filename:=Sheets("Summary").Range("C1").Value) 'Workbook we will be copying data from, our source file
Set wsCopy = wbCopy.Sheets(1) 'Worksheet we will be copying data from
As a follow on from the comments - here is a function to check if a workbook is open and if not, open it then return a reference to avoid these issues:
Public Function GetWorkBook(ByVal sFullName As String, Optional ReadOnly As Boolean) As Workbook
Dim sFile As String: sFile = Dir(sFullName)
On Error Resume Next
Set GetWorkBook = Workbooks(sFile)
If GetWorkBook Is Nothing Then Set GetWorkBook = Workbooks.Open(sFullName, ReadOnly:=ReadOnly)
End Function
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 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
I've seen quite a few examples for making a full copy of a worksheet but none of them are working for me. In my case the sheet has to go into a new workbook. In my actual code wb is defined global and the workbook is created in another sub that called this one.
Dim wb As Workbook
Set wb = Workbooks.Add()
Dim newtab as Worksheet
With ActiveWorkbook
.Sheets("Sample Attendance").Copy After:=wb.Sheets(.Sheets.Count)
Set newtab = wb.Sheets(wb.Sheets.Count - 1)
End With
didn't work.
Likewise
ActiveWorkbook.Sheets("Sample Attendance").Copy After:=wb.Sheets(1)
Set newtab = wb.Sheets("Sample Attendance")
newtab.Name = tabname
both methods return after the Copy statement.
I've been moderately successful with this:
Set newtab = wb.Worksheets.Add
newtab.Name = tabname
Set Attendance = ThisWorkbook.Sheets("Sample Attendance")
Attendance.Range("A:BB").Copy Destination:=newtab.Cells(1, 1)
which works. But then I have to copy all of the PageSetup across which is giving me fits and takes forever.
I see two problems with your 1st piece of code...
You are using Activeworkbook. When you add a new workbook, the new workbook becomes your active workbook :)
The second problem is the DOT before .Sheets.Count in wb.Sheets(.Sheets.Count). why pick the count from the workbook you are copying?
Try this
Sub Sample()
Dim thiswb As Workbook, wb As Workbook
Dim newtab As Worksheet
Set thiswb = ThisWorkbook
Set wb = Workbooks.Add()
With thiswb
.Sheets("Sample Attendance").Copy After:=wb.Sheets(wb.Sheets.Count)
Set newtab = wb.Sheets(wb.Sheets.Count - 1)
End With
End Sub
Give this a shot:
Sub SheetCopier()
Dim OriginalWB As Workbook
Dim NewWB As Workbook
Set OriginalWB = ActiveWorkbook
Workbooks.Add
Set NewWB = ActiveWorkbook
OriginalWB.Sheets("qwerty").Copy Before:=NewWB.Sheets(1)
End Sub
What I need is a way to send the contents of some cells in "ThisWorkbook" (where the macro is) to a specific sheet in another workbook (the location of which will not change, unlike "ThisWorkbook")
for some reason, this below dosen't work:
Sub Transplant()
Dim thispath As String
Dim targetpath As String
'Set filepaths
thispath = ThisWorkbook.FullName
targetpath = ThisWorkbook.Path & "/subdir/Targetbook.xlsm"
Dim Srcwb As Workbook
Dim Trgwb As Workbook
'Set workbooks
Set Srcwb = Workbooks.Open(thispath)
Set Trgwb = Workbooks.Open(targetpath)
Srcwb.Worksheets("Sheet1").Range(Srcwb .Worksheets("Sheet1").Range("A1"), _
Srcwb.Worksheets("Sheet1").Range("A1").End(xlToRight)).Copy _
Destination:=Trgwb.Sheets("Sheet1").Cells(1, 1)
End Sub
Please help!
//Leo
This is pretty much the same as what you've got, although I didnt re-open the active workbook.
Can you describe the range you're trying to copy? You might find that UsedRange is easier.
Sub Transplant()
Dim DWB As Workbook
Dim S As Worksheet
Set S = ThisWorkbook.WorksheetS("Sheet1") ' forgot to rename Source to S
Set DWB = Application.Workbooks.Open(Thisworkbook.Path & "/subdir/Targetbook.xlsm")
Set D = DWB.Worksheets("Sheet1")
S.Range(S.Range("A1"), S.Range("A1").End(xlToRight)).Copy Destination:=D.Cells(1,1)
' S.UsedRange.Copy Destination:=D.Cells(1,1) - this might be easier
End Sub