I have looked around for awhile and cant seem to locate what I need.
Refer to Workbooks
If you know there are only two workbooks open, you can use the Index property.
Sub ReferToWorkbooks()
Dim wb1 As Workbook
Dim wb2 As Workbook
Set wb1 = Workbooks(1)
Set wb2 = Workbooks(2)
Debug.Print wb1.Name
Debug.Print wb2.Name
End Sub
It is better to loop through all open workbooks and then create references to the ones you need.
Sub ReferToWorkbooks2()
Dim wb As Workbook
For Each wb In Workbooks
Debug.Print wb.Name
Next
End Sub
In case you have a worksheet in your code you use the Parent property:
Sub ReferToWorkbooks3()
Dim ws As Worksheet
Dim wb As Workbook
Set ws = Worksheets("Sheet1")
Debug.Print ws.Parent.Name
' or
Set wb = ws.Parent
Debug.Print wb.Name
End Sub
In case you have a range in your code you use the Parent property twice:
Sub ReferToWorkbooks4()
Dim rng As Range
Dim wb As Workbook
Set rng = Range("A1")
Debug.Print rng.Parent.Parent.Name
' or
Set wb = rng.Parent.Parent
Debug.Print wb.Name
End Sub
You should better explain the scenario where you might need this.
Related
I am trying to open two workbooks then copying the first sheet of one workbook to last sheet of another workbook. But getting "copy method of worksheet failed" error. could you please help me to sort out the issue.
Sub copysheets()
Dim wb As Workbook
Dim wba As Workbook
Dim wbk As Workbook
Dim i As Integer
Dim lrow As Long
Set wb = ThisWorkbook
lrow = wb.Sheets("Target").Range("A" & Rows.Count).End(xlUp).Row
For i = 6 To lrow
Set wba = Workbooks.Open(wb.Sheets("Target").Range("D3"))
Set wbk = Workbooks.Open(wb.Sheets("Target").Range("A" & i))
wbk.Sheets(1).copy After:=wba.Sheets(wba.Sheets.Count)
wbk.Close savechanges:=False
Next i
End Sub
How do I call and re-use the workbook that gets created after executing
ThisWorkbook.Sheets("copythis").Copy
I can't use the activeWorkbook since the user will go back to the previous workbook that has the vba.
Dim wbNew As Workbook
ThisWorkbook.Sheets("copythis").Copy
Set wbNew = ActiveWorkbook
MsgBox wbNew.Name
Even if the user goes back and selects something else, you can work with the new workbook using the wbNew object.
The newly created workbook will always be at the end of workbook array. So you can use this also
Dim wbNew
set wbNew = Application.Workbooks(Application.Workbooks.Count)
Worksheet.Copy Method
When using your line of code, the newly created workbook becomes the active one.
The Code
Option Explicit
Sub testWithVariable()
ThisWorkbook.Sheets("copythis").Copy
Dim wb As Workbook
Set wb = ActiveWorkbook
Debug.Print wb.Name
wb.Saved = True
End Sub
Sub testWithoutVariable()
ThisWorkbook.Sheets("copythis").Copy
With ActiveWorkbook
Debug.Print .Name
.Saved = True
End With
End Sub
Sub testWorksheetWithoutVariable()
ThisWorkbook.Sheets("copythis").Copy
With ActiveSheet
Debug.Print .Parent.Name ' workbook
Debug.Print .Name ' worksheet
.Parent.Saved = True
End With
End Sub
I have two workbooks with worksheets (having the same names). I would like copy and paste specific cells from one worksheet to another if the name of worksheets are the same.
I tried to compare name of worksheets with array based on names from another workbook but stack when comes to comparison
Sub check()
Dim xArray, i
Dim x As Workbook
Dim ws As Worksheet
Set x = Workbooks.Open("C:\Users\user\Desktop\xxx.xlsx", False)
With x
ReDim xArray(1 To Sheets.Count)
For i = 1 To Sheets.Count
xArray(i) = x.Sheets(i).Name
Debug.Print xArray(i)
Next
End With
x.Close (False)
For Each ws In ThisWorkbook.Worksheets
If ws.Name = xArray Then
' copy for each worksheet define in xArray xxx.xlsx file, range A1,B4,D5:G5
' and paste to worksheet with the same name in this open workbook
End Sub
Thanks for any help !
Use an Error handler to test if the sheet exists.
Sub check()
Dim wb As Workbook, SouceWorksheet As Worksheet, TargetWorksheet As Worksheet
Set wb = Workbooks.Open("C:\Users\user\Desktop\xxx.xlsx", False)
For Each SouceWorksheet In wb.Worksheets
On Error Resume Next
Set TargetWorksheet = ThisWorkbook.Worksheets(SouceWorksheet.Name)
On Error GoTo 0
If Not TargetWorksheet Is Nothing Then
SouceWorksheet.Range("A1").Copy TargetWorksheet.Range("A1")
SouceWorksheet.Range("B4").Copy TargetWorksheet.Range("B4")
SouceWorksheet.Range("D5:G5").Copy TargetWorksheet.Range("D5:G5")
End If
Next
wb.Close False
End Sub
for this functionality , you don't need to create array , it can be done easily with simple logic mentioned below.Also you can customize or replace your workbook and worksheet name and your copy-paste range in the below code.
Sub so()
Dim wb As Workbook
Dim wb1 As Workbook
Set wb = Workbooks("Book1.xlsx")
Set wb1 = Workbooks("Book2.xlsx")
Dim wk As Worksheet
Set wk = wb.Worksheets("Sheet1")
Dim wm As Worksheet
Set wm = wb1.Worksheets("Sheet1")
If (wk.Name = wm.Name) Then
Dim TR As Integer
TR = wk.Range("A" & Rows.Count).End(xlUp).Row
wk.Range("A1:A" & TR).Copy wm.Range("A1")
Application.CutCopyMode = False
End If
End Sub
I want to copy/paste all worksheet inlcuding the values/formula in the cells to another new workbook.
This code just copy the first ws, but not all other. How can I make sure, that all ws are gettin copied and pasted without writing all the names from the ws in the vba-code?
Sub CopyPaste()
Dim ws As Worksheet, wb As Workbook
Set ws = ActiveSheet
Set wb = Workbooks.Add(xlWBATWorksheet)
ws.Range("A1:G10").Copy
wb.Sheets(1).Range("A1").PasteSpecial Paste:=xlPasteValues
wb.Sheets(1).Range("A1").PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
End Sub
So i assume you will be saving the second workbook for it to be named? therefore just add your path below where you want to save it, also it now retains the sheet names.
I'm not sure why you are getting a debugger error its working fine for me, try this code and see if you still get it?
Sub newworkbook()
Dim WBN As workbook, WBC As workbook, WB As workbook
Dim WS As String
Dim SHT As Worksheet
Set WBN = Workbooks.Add
For Each WB In Application.Workbooks
If WB.Name <> WBN.Name Then
For Each SHT In WB.Worksheets
SHT.Copy After:=WBN.Sheets(WBN.Worksheets.Count)
WBN.Sheets(WBN.Worksheets.Count).Name = (SHT.Name) & " "
Next SHT
End If
Next WB
Application.DisplayAlerts = False
WBN.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Delete
WBN.Application.DisplayAlerts = True
ActiveWorkbook.SaveAs "C:\YOURPATH\timetable_v2.xls" 'change path to whatever
End Sub
You can try as follow:
Sub CopyPaste()
Dim aSheet As Worksheet
Dim workbook As workbook
Dim index As Integer
Set workbook = Workbooks.Add(xlWBATWorksheet)
For Each aSheet In Worksheets
aSheet.Range("A1:G10").Copy
workbook.Sheets(index).Range("A1").PasteSpecial Paste:=xlPasteFormulasAndNumberFormats
index = index + 1
Application.CutCopyMode = False
Next aSheet
End Sub
Just had a quick look for you, this seems to do the job:
credit: get digital help
Dim WBN As Workbook, WBC As Workbook, WB As Workbook
Dim WS As String
Dim SHT As Worksheet
Set WBN = Workbooks.Add
For Each WB In Application.Workbooks
If WB.Name <> WBN.Name Then
For Each SHT In WB.Worksheets
SHT.Copy After:=WBN.Sheets(WBN.Worksheets.Count)
WBN.Sheets(WBN.Worksheets.Count).Name = Left(WB.Name, 30 - Len(SHT.Name)) & "-" & SHT.Name
Next SHT
End If
Next WB
Application.DisplayAlerts = False
WBN.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Delete
WBN.Application.DisplayAlerts = True
I just deleted WBN.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Delete
And it works fine
The new workbook is saved as an .xlsx file, but of course I Need it as an .xlsm file....when I just added it into the path, it doesnt work
ActiveWorkbook.SaveAs "U:\Excel\timetable_v2.xlsm"
I'm probably missing something simple here. It just isn't copying the data from the source workbook to the target workbook and no errors are tripping. The source workbook is opening just fine. The target workbook contains this code. Both workbooks contain a sheet called 'Data'. Any help would be greatly appreciated.
Sub TransferData()
Dim wbTarget As Workbook
Dim wbSource As Workbook
Set wbSource = Workbooks.Open("C:\folder\source.xls")
Set wbTarget = Workbooks.Open("C:\folder\target.xlsm")
wbSource.Activate
Sheets("Data").Select
ActiveSheet.Range("B7").Copy
wbTarget.Activate
Sheets("Data").Select
ActiveSheet.Range("A1").Paste
End Sub
I think your problem is here:
ActiveSheet.Range("B7").Copy
Excel doesn't know which workbook to copy from:
With wbSource
.Activate
.Sheets("Data").Select
.ActiveSheet.Range("B7").Copy
End With
With wbTarget
.Activate
.Sheets("Data").Select
.ActiveSheet.Range("A1").Paste
End With
Try this code without select statements.
Also, you said the code is in your target workbook?
If you're opening both workbooks, the code should be in a third, unrelated workbook.
Sub TransferData()
Dim wbTarget As Workbook
Dim wbSource As Workbook
Set wbSource = Workbooks.Open("C:\folder\source.xls")
Set wbTarget = Workbooks.Open("C:\folder\target.xlsm")
wbSource.Sheets("Data").Range("B7").Copy wbTarget.Sheets("Data").Range("A1")
wbTarget.Close(True)
wbSource.Close(True)
End Sub
Here is code I use on a daily basis to copy a spreadsheet from one workbook to another:
Dim TWB As Workbook
Dim CopyWB As Workbook
Set TWB = ThisWorkbook
Set CopyWB = Workbooks.Open(FName, ReadOnly:=True)
CopyWB.Sheets(TWB.Sheets("Menu").ComboBox1.Text).Cells.Copy TWB.Sheets("DataSheet").Cells
CopyWB.Close (False)
Can't you store the value instead of copy paste
Sub TransferData()
Dim wbTarget As Workbook
Dim wbSource As Workbook
Set wbTarget = Application.ActiveWorkbook
Set wbSource = Workbooks.Open("C:\folder\source.xls")
wbSource.Activate
Sheets("Data").Select
xValue = ActiveSheet.Range("B7").Value
wbTarget.Activate
Sheets("Data").Select
ActiveSheet.Range("A1").Value = xValue
End Sub