VBA Debug code for using a partial name match to copy and paste between active/open workbooks - vba

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

Related

Vba macro subscript out of range

Can't seem to figure out why I'm getting a run time error on the second line. Help please
Dim wb As Workbook
Set wb = Workbooks(PLC)
wb.Close SaveChanges:False
Application.DisplayAlerts=True
End sub
give this a shot
Sub test()
Dim wb As Workbook
Set wb = Workbooks("PLC.xlsx")
wb.Close SaveChanges:=False
Application.DisplayAlerts = True
End Sub
When you wish to open a workbook you should use the Workbooks.Open method. Workbooks(index) only applies to workbooks that are already opened. You can check if a workbook is already open by doing e.g.
Dim wb as workbook, isOpen as boolean, myName as string
myName = "PLC"
bIsOpen = false
For each wb in Workbooks
If wb.Name = myName Then
bIsOpen = true
End if
Next wb
And use the result in your next step.

Copy Data from one open Workbook into another open workbook

Following code:
Sub CopyData()
Dim Wb1 As Workbook, wb2 As Workbook
For Each wB In Application.Workbooks
If Left(wB.Name, 21) = "Open Order Monitoring" Then
Set Wb1 = wB
Exit For
End If
Next
Set wb2 = ThisWorkbook
Wb1.Sheets(1).Range("A2").Range(.Cells(1, 1), .End(xlDown).Cells(1, 39)).Copy wb2.Sheets(2).Range("B5")
End Sub
The macro should copy data from a open workbook with variable name (open order monitoring[...]) and paste into the second sheet of the workbook I run the macro from.
But the line:
Wb1.Sheets(1).Range("A2").Range(.Cells(1, 1), .End(xlDown).Cells(1, 39)).Copy wb2.Sheets(2).Range("B5")
gives me an error. can someone solve this problem?
since:
it's always safer to use fully qualified range references (down to workbook and worksheet ones). especially when you're dealing with multiple workbooks and/or worksheets
should you only be interested in pasting values, it's faster (and safer, too) use Range1.value = Range2.Value instead of .Copy() method of Range object.
then, here follows a possible code:
Option Explicit
Sub CopyData()
Dim Wb1 As Workbook, wb2 As Workbook, wB As Workbook
Dim rngToCopy As Range
For Each wB In Application.Workbooks
If Left(wB.Name, 21) = "Open Order Monitoring" Then
Set Wb1 = wB
Exit For
End If
Next
If Not Wb1 Is Nothing Then '<~~ check if you actually found the needed workbook
Set wb2 = ThisWorkbook
With Wb1.Sheets(1)
Set rngToCopy = .Range("A2:AM2", .Cells(.Rows.Count, "A").End(xlUp))
End With
wb2.Sheets(2).Range("B5:AN5").Resize(rngToCopy.Rows.Count).Value = rngToCopy.Value
End If
End Sub
Pls try with below code
Sub CopyData()
Dim Wb1 As Workbook, wb2 As Workbook, wb As Workbook
Set wb2 = ThisWorkbook
For Each wb In Workbooks
If Left(wb.Name, 21) = "Open Order Monitoring" Then
Set Wb1 = wb
Exit For
End If
Next
Wb1.Sheets(1).Range("A2:AM2").Copy wb2.Sheets(2).Range("B5") 'Edited here
End Sub

Save Selected Sheets to a different work book in VBA

I would like to save a number of worksheets from the current workbook to a different workbook and exclude a sheet named "buttons" (in current one) from that saving process.
Can anybody help please? The number of worksheets is changeable FYI.
Below is what I have so far which include all the sheets from current workbook.
Sub SaveAs()
D1 = VBA.Format(Now, "mm_DD_yyyy")
For Each ws In Application.Workbooks
ws.SaveAs Filename:="C:\Users\e2309\Desktop\Andy's\GBB_Report_" & D1 & ".csv"
Next ws
Application.Quit
End Sub
Or more directly
copy the entire workbook
delete the redundant sheet
code
Sub Simpler()
Dim wb As Workbook
Dim strFile As String
strFile = "C:\temp\yourfile.xlsm"
ThisWorkbook.SaveAs strFile, xlOpenXMLWorkbookMacroEnabled
Application.DisplayAlerts = False
ThisWorkbook.Sheets("buttons").Delete
Application.DisplayAlerts = True
End Sub
This might get you a little closer. Note this is not complete and very untested.
Sub work()
Dim WB As Workbook
Dim Nwb As Workbook
Dim WS As Worksheet
Set Nwb = New Workbook
Set WB = ThisWorkbook
For Each WS In WB.Sheets
If WS.Name <> "Don't copy" Then
WS.Copy Nwb.Sheets("sheet1")
End If
Next
Nwb.Save
End Sub

Excel VBA: Copying multiple sheets into new workbook

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 ]

Copying and pasting data using VBA code

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.