I have a button on a spreadsheet that, when pressed, should allow the user to open a file, then copy columns A-G of the spreadsheet "Data", then paste the data from those columns on the current sheet.
I have a logic error in the code; it runs, but it pastes the selection in the wrong place.
I am having trouble referencing the two workbooks.
Here is my code:
Sub Button1_Click()
Dim excel As excel.Application
Dim wb As excel.Workbook
Dim sht As excel.Worksheet
Dim f As Object
Set f = Application.FileDialog(3)
f.AllowMultiSelect = False
f.Show
Set excel = CreateObject("excel.Application")
Set wb = excel.Workbooks.Open(f.SelectedItems(1))
Set sht = wb.Worksheets("Data")
sht.Activate
sht.Columns("A:G").Select
Selection.Copy
Range("A1").Select
ActiveSheet.Paste
wb.Close
End Sub
Use the PasteSpecial method:
sht.Columns("A:G").Copy
Range("A1").PasteSpecial Paste:=xlPasteValues
BUT your big problem is that you're changing your ActiveSheet to "Data" and not changing it back. You don't need to do the Activate and Select, as per my code (this assumes your button is on the sheet you want to copy to).
'So from this discussion i am thinking this should be the code then.
Sub Button1_Click()
Dim excel As excel.Application
Dim wb As excel.Workbook
Dim sht As excel.Worksheet
Dim f As Object
Set f = Application.FileDialog(3)
f.AllowMultiSelect = False
f.Show
Set excel = CreateObject("excel.Application")
Set wb = excel.Workbooks.Open(f.SelectedItems(1))
Set sht = wb.Worksheets("Data")
sht.Activate
sht.Columns("A:G").Copy
Range("A1").PasteSpecial Paste:=xlPasteValues
wb.Close
End Sub
'Let me know if this is correct or a step was missed. Thx.
Related
I found this code in another thread here but can't get it working in my book...
What I'm trying to achieve is... The macro to be called from a wb called "SHIFT REPORT*" which looks for and switches to a wb called "PlayerTransactionReport*" to copy some data before switching back to the SHIFT REPORT and pasting it in.
The code I have is:
Sub Import_Data()
Dim wb As Workbook
Dim ShiftReport As Workbook
Dim PlayerTransactionReport As Workbook
Set ShiftReport = ThisWorkbook
For Each wb In Workbooks
If Left(wb.Name, 23) = "PlayerTransactionReport" Then Set PlayerTransactionReport = wb
Next
Sheets("Sheet1").Select
Columns("A:Z").Select
Selection.Copy
Set PlayerTransactionReport = ThisWorkbook
For Each wb In Workbooks
If Left(wb.Name, 10) = "ShiftReport" Then Set ShiftReport = wb
Next
Sheets("Data").Select
Range("A1").Select
ActiveSheet.Paste
End Sub
Currently, it's not setting the PlayerTransactionReport to the active wb but throughout the process of debugging this by myself I've had various degrees of success, but I fear that this one might have between me, Please Help!
Thanks, Stuart
You have to refer to the Parent Worksheet, whenever you are refering to Sheets() and Columns():
Sub Import_Data()
Dim wb As Workbook
Dim ShiftReport As Workbook
Dim PlayerTransactionReport As Workbook
Set ShiftReport = ThisWorkbook
For Each wb In Workbooks
If Left(wb.Name, 23) = "PlayerTransactionReport" Then Set PlayerTransactionReport = wb
Next
PlayerTransactionReport.Sheets("Sheet1").Select
Columns("A:Z").Select
Selection.Copy
Set PlayerTransactionReport = ThisWorkbook
For Each wb In Workbooks
If Left(wb.Name, 10) = "ShiftReport" Then Set ShiftReport = wb
Next
PlayerTransactionReport.Sheets("Data").Select
Range("A1").Select
ActiveSheet.Paste
End Sub
If you do not refer to the parent worksheet, then the ActiveSheet or the sheet where the code is, is the one referred.
As a next step you can improve the following 2 points:
How to avoid using Select in Excel VBA
Check whether the PlayerTransactionReport is not Nothing, before calling it:
If Not PlayerTransactionReport Is Nothing Then
PlayerTransactionReport.Sheets("Sheet1").Select
Columns("A:Z").Select
Selection.Copy
End If
Stop using Select and Activate.
Sub Import_Data()
Dim w As long
Dim PlayerTransactionReport As Workbook, ShiftReport As Workbook
Set ShiftReport = ThisWorkbook
For w = 1 to Workbooks.count
If Left(Workbooks(w).Name, 23) = "PlayerTransactionReport" Then
Set PlayerTransactionReport = Workbooks(w)
exit for
end if
Next w
if w > Workbooks.count then
debug.print "cannot find PlayerTransactionReport"
exit sub
end if
PlayerTransactionReport.workSheets("Sheet1").Columns("A:Z").Copy _
destination:=ShiftReport.workSheets("Data").Range("A1").
End Sub
I am trying to open a text file and copy and paste it into my Data Sheet. However i can't seem to make it work (I see an object required error). Any help please? Thank you
Sub Bam2()
Dim FilesToOpen
Dim wkbAll As Workbook
Dim wkbTemp As Workbook
Dim newSheet As Worksheet
Dim targetSheet As Worksheet, sourceSheet As Worksheet
Dim customerWorkbook As Workbook, targetWorkbook As Workbook
Set targetWorkbook = Application.Workbooks("Book1.xlsm")
Set targetSheet = targetWorkboook.Sheets("Data")
targetSheet.Range("A1:M5000").ClearContents
FilesToOpen = Application.GetOpenFilename(Title:="Text Files to Open")
Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen, Format:=4)
wkbTemp.Sheets(1).Cells.Copy
targetSheet.Range("A1").PasteSpecial xlPasteValues
Application.CutCopyMode = 0
wkbTemp.Close
End Sub
At a guess
Set targetWorkbook = Application.Workbooks("Book1.xlsm")
If you've just created a workbook it's called Book1 - it's not called Book1.xlsm unless you've actually saved it under that name. Try
Set targetWorkbook = Application.Workbooks("Book1")
It does work when doing this, but how do I select to copy just one column in a specific range, and not the whole file?
Sub Bam()
Dim FilesToOpen
Dim wkbAll As Workbook
Dim wkbTemp As Workbook
Dim newSheet As Worksheet
FilesToOpen = Application.GetOpenFilename(Title:="Text Files to Open")
Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen, Format:=4)
wkbTemp.Sheets(1).Cells.Copy
Set newSheet = ThisWorkbook.Sheets("Data")
With newSheet
.PasteSpecial
End With
Application.CutCopyMode = False
wkbTemp.Close
End Sub
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
can someone please tell me why the data is not copying and pasting (or why it is copying and pasting blank data? Also is there a way to speed the automation?
Sub GetDataCopyPaste()
Dim wbTarget As Workbook 'where the data will be pasted
Dim wbSource As Workbook 'where the data will be copied
Dim StrName As String 'name of the source sheet
Application.ScreenUpdating = False 'these statements help performance by disabling the self titled in each, remeber to re-enable at end of code
Application.DisplayAlerts = False
Set wbTarget = ActiveWorkbook 'set to the current workbook
StrName = ActiveSheet.Name 'get active sheetname of workbook
Set wbSource = Workbooks.Open("C:\Users\jjordan\Desktop\Test Dir\Test File Test\metrics list.xlsx") 'opens Target workbook
Set wbTarget = Workbooks.Open("C:\Users\jjordan\Desktop\Test Dir\MASTER\Weekly Logbook - 2016.xlsm") 'opens Source workbook
wbSource.Sheets("IOS").Range("A1:E60").Value = wbTarget.Sheets("Sheet6").Range("A1:E60").Value 'copy & pastes source data onto Target workbook
wbTarget.Save 'save workbook
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
This line is backwards
wbSource.Sheets("IOS").Range("A1:E60").Value = wbTarget.Sheets("Sheet6").Range("A1:E60").Value 'copy & pastes source data onto Target workbook
You need
wbTarget.Sheets("Sheet6").Range("A1:E60") = wbSource.Sheets("IOS").Range("A1:E60").value
I just tested and succeeded
Option Explicit
Sub test()
Dim myWB As Workbook
Set myWB = Workbooks.Open("C:\Users\raystafarian\Downloads\Book3.xlsx")
Dim yourWB As Workbook
Set yourWB = Workbooks.Open("C:\Users\raystafarian\Downloads\Book2.xlsm")
myWB.Sheets("Sheet1").Range("C1:C4").Value = yourWB.Sheets("Sheet1").Range("A1:A4").Value
End Sub
I have an error message of 'Object Required' when I run this sub. I have a version for copying each specific sheet, which works fine, but this sub is for all sheets within the WB ie to copy each one's WholePrintArea and paste it into a new sheet in the new WB. Thanks...
Sub NewWBandPasteSpecialALLSheets()
MyBook = ActiveWorkbook.Name ' Get name of this book
Workbooks.Add ' Open a new workbook
NewBook = ActiveWorkbook.Name ' Save name of new book
Workbooks(MyBook).Activate ' Back to original book
Dim SH As Worksheet
For Each SH In MyBook.Worksheets
SH.Range("WholePrintArea").Copy
Workbooks(NewBook).Activate
With SH.Range("A1")
.PasteSpecial (xlPasteColumnWidths)
.PasteSpecial (xlFormats)
.PasteSpecial (xlValues)
End With
Next
End Sub
Try do something like this (the problem was that you trying to use MyBook.Worksheets, but MyBook is not a Workbook object, but string, containing workbook name. I've added new varible Set WB = ActiveWorkbook, so you can use WB.Worksheets instead MyBook.Worksheets):
Sub NewWBandPasteSpecialALLSheets()
MyBook = ActiveWorkbook.Name ' Get name of this book
Workbooks.Add ' Open a new workbook
NewBook = ActiveWorkbook.Name ' Save name of new book
Workbooks(MyBook).Activate ' Back to original book
Set WB = ActiveWorkbook
Dim SH As Worksheet
For Each SH In WB.Worksheets
SH.Range("WholePrintArea").Copy
Workbooks(NewBook).Activate
With SH.Range("A1")
.PasteSpecial (xlPasteColumnWidths)
.PasteSpecial (xlFormats)
.PasteSpecial (xlValues)
End With
Next
End Sub
But your code doesn't do what you want: it doesen't copy something to a new WB. So, the code below do it for you:
Sub NewWBandPasteSpecialALLSheets()
Dim wb As Workbook
Dim wbNew As Workbook
Dim sh As Worksheet
Dim shNew As Worksheet
Set wb = ThisWorkbook
Workbooks.Add ' Open a new workbook
Set wbNew = ActiveWorkbook
On Error Resume Next
For Each sh In wb.Worksheets
sh.Range("WholePrintArea").Copy
'add new sheet into new workbook with the same name
With wbNew.Worksheets
Set shNew = Nothing
Set shNew = .Item(sh.Name)
If shNew Is Nothing Then
.Add After:=.Item(.Count)
.Item(.Count).Name = sh.Name
Set shNew = .Item(.Count)
End If
End With
With shNew.Range("A1")
.PasteSpecial (xlPasteColumnWidths)
.PasteSpecial (xlFormats)
.PasteSpecial (xlValues)
End With
Next
End Sub
Rethink your approach. Why would you copy only part of the sheet? You are referring to a named range "WholePrintArea" which doesn't exist. Also you should never use activate, select, copy or paste in your script. These make the "script" vulnerable to user actions and other simultaneous executions. In worst case scenario data ends up in wrong hands.
This worked for me (I added an "if sheet visible" because in my case I wanted to skip hidden sheets)
Sub Create_new_file()
Application.DisplayAlerts = False
Dim wb As Workbook
Dim wbNew As Workbook
Dim sh As Worksheet
Dim shNew As Worksheet
Dim pname, parea As String
Set wb = ThisWorkbook
Workbooks.Add
Set wbNew = ActiveWorkbook
For Each sh In wb.Worksheets
pname = sh.Name
If sh.Visible = True Then
sh.Copy After:=wbNew.Sheets(Sheets.Count)
wbNew.Sheets(Sheets.Count).Cells.ClearContents
wbNew.Sheets(Sheets.Count).Cells.ClearFormats
wb.Sheets(sh.Name).Activate
Range(sh.PageSetup.PrintArea).Select
Selection.Copy
wbNew.Sheets(pname).Activate
Range("A1").Select
With Selection
.PasteSpecial (xlValues)
.PasteSpecial (xlFormats)
.PasteSpecial (xlPasteColumnWidths)
End With
ActiveSheet.Name = pname
End If
Next
wbNew.Sheets("Hoja1").Delete
Application.DisplayAlerts = True
End Sub
Since you are copying all worksheet, how about:
Copy & Paste (X)
SaveAS (O)
Sub Export()
Application.DisplayAlerts = False
On Error Resume Next
Dim NewWB As String
NewWB = Sheets("Control").Range("B42")
ActiveWorkbook.SaveAs Filename:=NewWB, FileFormat:=xlWorkbookNormal
ActiveWorkbook.Sheets("Control").Delete
End Sub
I had a worksheet "Control" handling all variant, you may change it yourself
On the other hand, if you really wish to use COPY & PASTE, you could use ARRAY
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=FolderPath & ExcelName & ".xlsx", FileFormat:=xlNormal
Workbooks(ExcelOrigin).Activate
Sheets(Array("for coversheet", "Pivot", "CCA", "FRR", "CRS", "GSA", "Inv Summary", "UploadtoJDE", "Comat")).Copy Before:=Workbooks(ExcelName).Sheets(1)
Sheets("Sheet1").Delete
Remember to Dim (FolderPath,ExcelName,ExcelOrigin) as String
As equal them to your file name & file path
[ i can't type in those here because of error ]