I am trying to copy an object from a closed workbook to the currently open workbook, the code I have bee experimenting with is:
Sub test()
Dim WB1 As Workbook
Dim WBDest As Workbook
Set WBDest = Workbooks(ActiveWorkbook.Path & "\" & ActiveWorkbook.Name)
'Open up your first workbook, copy data
Set WB1 = Workbooks.Open("path to the folder\testbook.xlsx")
WB1.Sheets("Sheet1").Range("A1:F12").Copy
'paste in second workbook
WBDest.Sheets("Sheet1").Range("A1").PasteSpecial
'Close first workbook
WB1.Close savechanges:=False
End Sub
I keep getting a "subscript out of range" error with this, if I remove the WBDest info and used activeworkbook instead, it copies the object and pastes it in the same workbook as it is the activeworkbook at the time.
Could someone please guide me on this and help me figure out what I am doing wrong.
Thanks.
As mentioned by AndyG, it should be WBDest = Workbooks.Open(..). The replacement is then:
Sub test()
Dim WB1 As Workbook
Dim WBDest As Workbook
Set WBDest = Workbooks.Open(ActiveWorkbook.Path & "\" & ActiveWorkbook.Name)
'Open up your first workbook, copy data
Set WB1 = Workbooks.Open("path to the folder\testbook.xlsx")
WB1.Sheets("Sheet1").Range("A1:A7").Copy
'paste in second workbook
WBDest.Sheets("Sheet1").Range("A1:A7").PasteSpecial
'Close first workbook
WB1.Close savechanges:=False
End Sub
Note that on the 5th line you could as easily write WBDest = ActiveWorkbook if the workbook is already open as you suggest.
Related
I am hoping someone can assist. I have an excel macro filing (.xlsm) where I am pulling in data from other files and I am creating multiple Worksheets. I am trying to export one of those worksheets to a new Workbook that I'm creating each day with a dynamic file name, the file name includes the current date. I'm getting an error that "Excel cannot insert the sheets into the destination workbook, because it contains few rows and columns than the source workbook...". I assume this is because I am attempting to copy from .xlsm to .xlxs and I'm not sure how to solve this. Here is the code that I have:
Dim wb As Workbook
Set wb = Workbooks.Add
ThisWorkbook.Sheets("Data").Copy Before:=wb.Sheets(1)
wb.SaveAs "\\NetorkDrive\Filename " & Format(Now(), "MM_DD_YY") & ".xlsx"
I was expecting the information from the "Data" sheet to copy over to a new Workbook titled "Filename Date.xlsx" but I am getting the error referenced above.
Export Worksheet To a New Workbook
Sub ExportWorksheet()
Dim swb As Workbook: Set swb = ThisWorkbook ' workbook containing this code
Dim sws As Worksheet: Set sws = swb.Sheets("Data")
sws.Copy ' creates a single-worksheet workbook
Dim dwb As Workbook: Set dwb = Workbooks(Workbooks.Count) ' the last
Dim dPath As String
dPath = "\\NetworkDrive\Filename " & Format(Date, "MM_DD_YY") & ".xlsx"
Application.DisplayAlerts = False ' overwrite without confirmation
dwb.SaveAs dPath, xlOpenXMLWorkbook
Application.DisplayAlerts = True
'dwb.Close SaveChanges:=False ' it just got saved
MsgBox "Worksheet exported.", vbInformation
End Sub
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
I have several sheets I need to copy to a new workbook and then save this workbook.
I'm using the worksheet function to copy which it seems to me like it's the intended purpose of that function.
Here's the MSDN documentation on how to do this task:
Worksheets("Sheet1").Copy
With ActiveWorkbook
.SaveAs Filename:=Environ("TEMP") & "\New1.xlsx", FileFormat:=xlOpenXMLWorkbook
.Close SaveChanges:=False
End With
https://learn.microsoft.com/en-us/office/vba/api/excel.worksheet.copy
This is doing exactly what I want, but it's using the ActiveWorkbook property which might cause some error, if running other codes or just working in parallel of this code running.
I'm looking for a way to manipulate the newly created workbook without having to use the ActiveWorkbook property.
Something along the lines of this:
Dim wb as Workbook
set wb = Worksheets("Sheet1").Copy
wb.SaveAs Filename:=Environ("TEMP") & "\New1.xlsx", FileFormat:=xlOpenXMLWorkbook
wb.Close SaveChanges:=False
I've already tried this and it didn't work, but it's just to illustrate the point that it's not using the ActiveWorkbook property to refer to the new workbook.
Thanks in advance
From above comment:
Sub Tester()
With AsNewWorkbook(Sheet1)
Debug.Print .Name
.SaveAs "C:\Temp\blah.xlsx"
End With
End Sub
Function AsNewWorkbook(ws As Worksheet)
Dim wb As Workbook
Set wb = Workbooks.Add(xlWBATWorksheet) 'has one sheet...
With wb.Sheets(1) 'stolen from Cristian's answer...
If .Name = ws.Name Then .Name = .Name & "x"
End With
ws.Copy before:=wb.Worksheets(1)
Application.DisplayAlerts = False
wb.Worksheets(2).Delete
Application.DisplayAlerts = True
Set AsNewWorkbook = wb
End Function
#BigBen is right though - typically just using ActiveWorkbook is fine.
An improvement on #TimWilliams response so that you can copy multiple sheets at once:
Sub Test()
Dim sourceBook As Workbook
'
Set sourceBook = ThisWorkbook 'Or ActiveWorkbook or whatever book is needed
With CopySheetsToNewBook(sourceBook.Sheets(Array("Sheet1", "Sheet2")))
.SaveAs Filename:=Environ("TEMP") & "\New1.xlsx", FileFormat:=xlOpenXMLWorkbook
End With
sourceBook.Close SaveChanges:=False
End Sub
Public Function CopySheetsToNewBook(ByVal theSheets As Sheets) As Workbook
If theSheets Is Nothing Then
Err.Raise 91, "CopySheetsToNewBook", "Sheets not set"
End If
'
Dim newBook As Workbook
Dim tempSheet As Worksheet
'
Set newBook = Application.Workbooks.Add(xlWBATWorksheet)
Set tempSheet = newBook.Worksheets(1) 'To be deleted later
tempSheet.Name = CDbl(Now) 'Avoid name clashes with the sheets to be copied
'
theSheets.Copy Before:=tempSheet
Application.DisplayAlerts = False
tempSheet.Delete
Application.DisplayAlerts = True
'
Set CopySheetsToNewBook = newBook
End Function
Copy Worksheet(s) to a New Workbook
Sub NewWorkbook()
' Reference the source workbook.
Dim swb As Workbook: Set swb = ThisWorkbook ' workbook containing this code
swb.Worksheets("Sheet1").Copy ' copy one worksheet to a new workbook
'swb.Worksheets(Array("Sheet1", "Sheet2")).Copy ' copy multiple worksheets
' Reference the destination (new) workbook.
Dim dwb As Workbook: Set dwb = Workbooks(Workbooks.Count)
Debug.Print swb.Name, dwb.Name
End Sub
I have the following macro:
Sub btnToCsv()
Dim Wb As Workbook
Dim Ds, Ws As Worksheet
Set Ds = Sheet1
Set Wb = Workbooks.Add
Set Ws = Wb.ActiveSheet
Ds.Range("A2:J200000").Copy Ws.Range("A1")
Application.DisplayAlerts = False
Wb.SaveAs ThisWorkbook.Path & "\MyCSV.csv", FileFormat:=xlCSV
MsgBox "Saved Successfully!"
Wb.Close
End Sub
The above macro gets activated from a button on an existing sheet. At the following line, a new workbook opens up on computer screen which might look a litte awkward for my non technical users. That temporary workbook closes at end of Sub.
Set Wb = Workbooks.Add
How do I disable or hide the temporary workbook from opening on screen?
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