Issues with moving Sheets between Workbooks - excel

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

Related

Workbook Referencing

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

Macro in Personal.xlsb - Active workbook reference [duplicate]

I have a number of scripts that are in a module in my Personal.xlsb file. It's kept hidden, but in this script, the idea is that you run it from within a different workbook each time. It opens a separate workbook (source.xlsx), copies a range from it, pastes into the original workbook, and then closes source.xlsx.
When it comes to the "ThisWorkbook.ActiveSheet.Paste" part, it's pasting it into the Personal.xlsb workbook instead of the target workbook that is actually open and visible. How can I make sure it's being pasted in the right workbook? The workbook's filename will always be different, so I can't specify a path or anything like that.
Sub CopyData()
Application.DisplayAlerts = False
Dim wbSource As Workbook
Set wbSource = Workbooks.Open(Filename:="source.xlsx", UpdateLinks:=3)
wbSource.Sheets(1).Range("A1:X105").Copy
ThisWorkbook.ActiveSheet.Paste
wbSource.Close
Application.DisplayAlerts = True
Call CopyCFormat
End Sub
Don't use ThisWorkbook in most cases, as it references the workbook that the macro is stored in (in this case, personal.xlsb).
Instead, you can use ActiveWorkbook to refer to whichever workbook has focus at the time the macro is run. You can also assign ActiveWorkbook to a variable for easier reference.
Sub CopyData()
Application.DisplayAlerts = False
Dim wbSource As Workbook
Dim wbTarget as Workbook
Set wbTarget = ActiveWorkbook
Set wbSource = Workbooks.Open(Filename:="source.xlsx", UpdateLinks:=3)
wbSource.Sheets(1).Range("A1:X105").Copy
wbTarget.ActiveSheet.Paste
wbSource.Close
Application.DisplayAlerts = True
Call CopyCFormat
End Sub
You could also reference the active sheet without specifying which workbook it's in, as:
Dim wbSource As Workbook
Dim shtTarget as Worksheet
Set shtTarget = ActiveSheet
Set wbSource = Workbooks.Open(Filename:="source.xlsx", UpdateLinks:=3)
wbSource.Sheets(1).Range("A1:X105").Copy
shtTarget.ActiveSheet.Paste
Luck!
If I understand it, you should just add another workbook variable.
Sub CopyData()
Dim mainWB As Workbook
Dim mainWS As Worksheet
Set mainWB = ActiveWorkbook
Set mainWS = mainWB.Sheets(1) ' Change this to whatever you need it to be
Application.DisplayAlerts = False
Dim wbSource As Workbook
Set wbSource = Workbooks.Open(Filename:="source.xlsx", UpdateLinks:=3)
wbSource.Sheets(1).Range("A1:X105").Copy
mainWS.Paste
wbSource.Close
Application.DisplayAlerts = True
Call CopyCFormat
End Sub

Copy tabs of similar partial name to another workbook

Would appreciate if there's any help anywhere. Let's say, I have the following tabs: Data Set 001, Data Set 002, Data Set 003, so long the tab names contain Data Set, it should copy over to another workbook (let's say Main File). Any help with regards to this is welcomed. Thanks all in advance!
Best Regards,
Josh
I used this in Workbook containing worksheet, "ASSESSMENT FORMxx":
Sub CopyWorksheetsToNewWorkbook()
'This macro is to be in the ActiveWorkbook
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim wb As Workbook
Dim ws As Worksheet
Set wb = Workbooks.Add
wb.SaveAs Filename:="Book10" & ".xlsx"
Workbooks.Open ("Book10.xlsx")
For Each ws In Workbooks("ActiveWorkbookName.xlsm").Sheets
If ws.Name Like ("ASSESSMENT FORM*") Then ws.Copy Before:=Workbooks("Book10.xlsx").Worksheets("Sheet1")
Next ws
Workbooks("Book10.xlsx").Worksheets("Sheet1").Move Before:=Workbooks("Book10.xlsx").Sheets(1)
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Note that both workbook with worksheet "ASSESSMENT FORMxx" and Book10.xlsx must be open.
Did you have a go at any code?
Sub Whatever()
Dim wb As Workbook
Dim ws As Worksheet
Set wb = Workbooks("AnyOpenWorkbookName.xlsx")
For Each ws In ThisWorkbook.Sheets
If ws.Name Like "Data Set" & "*" Then
Call ws.Copy(after:=wb.Sheets(wb.Sheets.Count))
End If
Next ws
End Sub
You need to loop through all Worksheets of your 1st Workbook, test if its name contains Data set with Worksheet.Name and InStr.
If the InStr function returns something else than 0 (meaning your Worksheet name contains Data Set), you can copy the current Worksheet to the 2nd Workbook.
Adapt this sample to your needs:
'Loop through all worksheets
If InStr(wsCurrent.Name,"Data Set") <> 0 Then
' Copy wsCurrent to new WorkBook
End If
' End of loop

Switch to other workbook

I am trying to build a code which would switch to the immediate other open workbook and copy data from there.
I can use workbook(1) and workbook(2) ,but problem is this index changes by sequence of opening workbooks.
So I want to put if function in it ,but doesnt work. Below is the code.
If ActiveWorkbook = Workbooks(1) Then
Workbooks(2).Activate
Else
Workbooks(1).Activate
End If
but it gives error 438 ,object doesn't support property or method.
Can you help me debug this?
Try the code below, the last section of the Copy >> Paste is just an example how you copy Range("A1:E10") from "Sheet1" in DestWB to ThisWB "Sheet1" (without using Activate or Select) - you should be able to modify it quite easily.
Code
Option Explicit
Sub CopyThisWorkBOok()
Dim ThisWB As Workbook
Dim DestWB As Workbook
Dim wb As Workbook
Dim i As Long
i = Application.Workbooks.Count
If i <> 2 Then ' check if number of open workbooks is 2
MsgBox "You need to have 2 open workbooks, currently there are " & i & " open workbooks", vbCritical
Exit Sub
Else
For Each wb In Application.Workbooks ' loop through all open workbooks
If wb.Name <> ThisWorkbook.Name Then
Set DestWB = wb
Else
Set ThisWB = ThisWorkbook
End If
Next wb
End If
' from here you start the part where you copy >> paste, there is no need to `Activate` or `Select` anything
DestWB.Worksheets("Sheet1").Range("A1:E10").Copy Destination:=ThisWB.Worksheets("Sheet1").Range("A2")
End Sub
You can use names of target objects, for example:
Workbooks("MyBook.xls").Worksheets("Sheet1").Activate
Depending on what you are trying to do, the description is not very clear, you can use a variation of this code. You can define the workbook that contains the VBA as "ThisWorkBook" and go from there.
Dim source_worksheet As Worksheet
Set source_worksheet = ThisWorkbook.Worksheets("Sheet2")
Dim target_worksheet As Worksheet
Set target_worksheet = ActiveWorkbook.Worksheets("Sheet1")
'Defines what sheet you are copying
source_worksheet.Copy After:=target_worksheet

Excel vba how to copy sheet with all formatting & page setup

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

Resources