I have a workbook called Sheeter Production Report that an operator fills out. Normally they click on the "End of Shift" button and it saves the workbook with the shift and date then reopens the blank Sheeter Production Report. Sometimes I need to transfer data from between the workbooks so I have it transfer the data to the reopened workbook. Here is the code to transfer the data.
Sub Transfer_1()
Range("G5").MergeArea.Copy
**Workbooks("Sheeter Production Report").Worksheets("Production Report").Range("G5").PasteSpecial xlPasteValues**
Range("G7").MergeArea.Copy
Workbooks("Sheeter Production Report").Worksheets("Production Report").Range("G7").PasteSpecial xlPasteValues
Range("H5").MergeArea.Copy
Workbooks("Sheeter Production Report").Worksheets("Production Report").Range("H5").PasteSpecial xlPasteValues
Range("I5").MergeArea.Copy
Workbooks("Sheeter Production Report").Worksheets("Production Report").Range("I5").PasteSpecial xlPasteValues
Range("K5").MergeArea.Copy
Workbooks("Sheeter Production Report").Worksheets("Production Report").Range("K5").PasteSpecial xlPasteValues
Range("L5").MergeArea.Copy
Workbooks("Sheeter Production Report").Worksheets("Production Report").Range("L5").PasteSpecial xlPasteValues
Range("M5").MergeArea.Copy
Workbooks("Sheeter Production Report").Worksheets("Production Report").Range("M5").PasteSpecial xlPasteValues
Range("N5").MergeArea.Copy
Workbooks("Sheeter Production Report").Worksheets("Production Report").Range("N5").PasteSpecial xlPasteValues
Range("Q5").MergeArea.Copy
Workbooks("Sheeter Production Report").Worksheets("Production Report").Range("Q5").PasteSpecial xlPasteValues
Range("AB5").MergeArea.Copy
Workbooks("Sheeter Production Report").Worksheets("Production Report").Range("R5").PasteSpecial xlPasteValues
Range("S5").MergeArea.Copy
Range("R5").PasteSpecial xlPasteValues
Range("AC5").Copy
Workbooks("Sheeter Production Report").Worksheets("Production Report").Range("X2").PasteSpecial xlPasteValues
I keep getting a Run-time error "9" Subscript out of range.
It renames the workbook perfectly fine, opens the Sheeter Production Report workbook without any issues but when it goes to copy and paste the data it kicks out the above error. I marked the line with **
I've created a blank workbook called Book1/Sheet1 and swapped that out with Sheeter Production Report/Production Report in the first line and it will transfer when using F5. But it kicks out the error again when it goes to the next line. Last week it was working perfectly fine. I have no idea what might have changed.
Any help would be much appreciated.
This is working for me:
Option Explicit
Sub Transfer_1()
Dim ws_Prod_Rpt As Worksheet
Dim ws_Dest_Sht As Worksheet
Dim RG As Range
Dim AddressList
Dim I As Long
Set ws_Dest_Sht = Workbooks("Book1.xlsm").Worksheets("Dest_Worksheet")
Set ws_Prod_Rpt = ThisWorkbook.Worksheets("Production Report")
AddressList = Array("G5", "G7", "H5", "I5", "K5", _
"L5", "M5", "N5", "Q5", "AB5", _
"S5", "R5", "AC5")
With ws_Prod_Rpt
For I = 0 To UBound(AddressList)
Debug.Print I & " - " & AddressList(I)
Set RG = .Range(AddressList(I)).MergeArea
Debug.Print RG.Address
ws_Dest_Sht.Range(AddressList(I)) = RG.Value
Next I
End With
End Sub
I think the With May be superfluous, however I had added it in when I thought it was more complicated.
Let me know if you run into issues.
Related
I am working on creating a macro to simplify things that I do on a daily basis. The idea behind this macro is to copy 7 worksheets from the parent report, open a new workbook, paste and hardcode the data, save it to my desktop and close the new workbook.
As I am working through debugging and testing my code I am running into a problem which I do not understand why it is happening. If I boot up windows and run the macro the first time in my excel workbook, I get no issues the first time I run it for the 7 reports. The problem comes up when I try to add code or fix issues and run the code again. I keep getting " Run-time error '1004' Application-defined or object defined error".
I am trying to debug and when I hit F8 for debugging and stepping into the code, it seems it gets hung up around step #4 when it is trying to close when I run it more than once. I am learning and using Leila Gharani's course, but I don't think I got this far in the course yet to understand. If someone can please help me so I can understand this concept, I would greatly appreciate it.
Thank you
'1. Select Parent Report and select BD Tab
Workbooks("Parent Report").Activate
Worksheets("BD").Select
'2. Select all cells from BD tab, open new workbook , paste data, and hardcode it.
Cells.Select
Cells.Copy
Workbooks.Add
Range("A1").PasteSpecial xlPasteAll
Cells.Select
Cells.Copy
Range("A1").PasteSpecial xlPasteValues
Cells.EntireRow.AutoFit
'3. Rename worksheet to BD and cell "A2" to BD.
ActiveWorkbook.ActiveSheet.Name = "BD"
Range("A2").Value = "BD"
Range("A1").Select
'4. Save current flash report to local drive, with monthly naming format and close it.
ActiveWorkbook.SaveAs "C:\Users\mylocaldriveinfo\Desktop\Flash Reports" & "\BD Monthly Reporting - Preliminary " & Format(Date, "mmm") & " " & Format(Date, "yyyy")
ActiveWorkbook.Close
I just figured it out. It was my one drive at work giving me an issue. I disabled it, as I never use it and doing so I have not been able to replicate the error.
I am sure this code isn't best practice, but it works for now.
Option Explicit
Sub CopySheets()
Const FOLDER = "C:\Users\mylocaldriveinfo\Desktop\Flash Reports\BD Monthly Reporting -"
Dim wbNew As Workbook, wbMaster As Workbook, sht, n As Long
Set wbMaster = ThisWorkbook
' create new workbook
Set wbNew = Workbooks.Add(1) ' 1 sheet
n = 1
For Each sht In Array("BD", "Sheet2", "Sheet3", "Sheet4", _
"Sheet5", "Sheet6", "SHeet7") ' 7 sheet names
wbMaster.Sheets(sht).Copy After:=wbNew.Sheets(n)
n = n + 1
With wbNew.Sheets(n)
.UsedRange.Value = .UsedRange.Value
.Range("A2") = sht
End With
Next
With wbNew
' delete blank sheet
Application.DisplayAlerts = False
.Sheets(1).Delete
Application.DisplayAlerts = True
' save
.SaveAs Filename:=FOLDER & Format(Date, "mmm yyyy")
.Close
End With
MsgBox "Done", vbInformation
End Sub
My first task every morning is to grab two files that are generated by another department. I then essentially "move" information around within the file to prepare for emails. One of the things that must be done is to have the addition of new sheets in which I was able to write a macro for and add it to the personal macro workbook. The issue that I'm running into however is that whenever new sheets are added, the macro will add them to the personal macro workbook instead of the file that I open every morning and need the sheets added to.
I believe this is in part to the section of the code (Below) that adds the sheets, however i am not sure what to use in place of this. Can someone please assist? Thanks
ThisWorkbook.Sheets.Add.Name = "PAV" ' This adds three new sheets
ThisWorkbook.Sheets.Add.Name = "PAS"
ThisWorkbook.Sheets.Add.Name = "PAD"
Below is the entire macro:
Sub PaidAgainst()
Dim Cll As Range
Dim myrange As Range
Application.ScreenUpdating = False
Set myrange = Application.Union(Range("E2", Range("E" & Rows.Count).End(xlUp)), Range("S2", Range("S" & Rows.Count).End(xlUp)))
On Error GoTo EH
ThisWorkbook.Sheets.Add.Name = "PAV" ' This adds three new sheets
ThisWorkbook.Sheets.Add.Name = "PAS"
ThisWorkbook.Sheets.Add.Name = "PAD"
For Each Cll In myrange
If Len(Cll) < 2 Then
Cll.Offset(1, 0).Copy
Cll.PasteSpecial xlPasteValues
End If
Next Cll
Sheet1.Select
Columns("J:J").Select
Selection.Cut
Columns("A:A").Select
Selection.Insert shift:=xlToRight
Range("D1").Select ' This adds a filter and selects "BAI" values only
Selection.AutoFilter
ActiveSheet.Range("$A$1:$S$7").AutoFilter Field:=4, Criteria1:="BAI"
Sheet1.Activate
Sheet1.Range("$A$1:$S$46").AutoFilter Field:=1, Criteria1:= _
"Paid against dormant"
Range("A1").CurrentRegion.Copy
Worksheets("PAD").Range("A1").CurrentRegion.PasteSpecial
Sheet1.Range("$A$1:$S$46").AutoFilter Field:=1, Criteria1:= _
"Paid against stop"
Range("A1").CurrentRegion.Resize(, 14).Copy
Worksheets("PAS").Range("A1").CurrentRegion.Resize(, 14).PasteSpecial
Sheet1.Range("$A$1:$S$46").AutoFilter Field:=1, Criteria1:= _
"Paid against void"
Range("A1").CurrentRegion.Resize(, 14).Copy
Worksheets("PAV").Range("A1").CurrentRegion.Resize(, 14).PasteSpecial
Exit Sub
EH:
MsgBox "An error occured"
Application.ScreenUpdating = True
End Sub
The problem is that ThisWorkbook refers to the workbook where the code is actually running from, in your case, your personal macro workbook.
Change the code to refer to ActiveWorkbook, which addresses the workbook that is currently in the active window.
Best would be to create a proper workbook variable and use that to reference workbooks and sheets within workbooks without any doubt.
dim wb as Workbook
set wb = ActiveWorkbook
[...] ' later in the code
wb.Worksheets("PAD").Range[...]
[...]
wb.Worksheets("Sheet1").Range("[...]
Problem:
Because the .xlsb (herein referred to as TheirFile.xlsb) is downloaded from a third party twice a week, the VBA script must be held by the .xlsm (MyFile.xlsm).
The process is simple:
Focus TheirFile.xlsb
Apply some filters on the data (headers at row 3)
Select the cell AW2 and copy the value (it contains a formula, this may be where the issue occurs)
Focus MyFile.xlsm
Select the cell J28 and paste with ...pastespecial xlPasteAll
However upon checking the code and hitting run, I get nothing in the cell.
Attempts:
Most of them are almost identical, and with the way I (attempt to) bug fix I honestly don't recall all of them.
I used variations on
Workbooks("TheirFile.xlsb").Activate
Range("AW2").Copy
to copy it without error, and
Workbooks("MyFile.xlsm").Activate
Range("j28").Select
ActiveCell.PasteSpecial xlPasteAll
to paste. Something here is failing without returning an error.
I have tried several ways of copying, even a clunky
Range("AW2").Select
x = Selection.Value
Workbooks("MyFile.xlsm").Activate
Range("j28").Select
Selection.Value = x
Which of course didn't work.
Current code and additional info:
Currently I have this in place
Option Explicit
Sub MyMacro() 'indentations for readability
Workbooks("TheirFile.xlsb").Activate
If ActiveSheet.FilterMode Then
ActiveSheet.ShowAllData
End If
'various filters
Dim x As Integer
Workbooks("TheirFile.xlsb").Activate
Range("AW2").Copy
Workbooks("MyFile.xlsm").Activate
Range("j28").Select
ActiveCell.PasteSpecial xlPasteAll
End Sub
The cell AW2 has a =SUBTOTAL(9,cell:cell) formula in it.
The cell j28 is a merged cell.
Questions:
Is there a quick fix for my code?
Would it be more effective to simply perform the subtotal again inside of VBA to avoid the issue?
FIXED
sheets("sheet1").range("AW2").copy
workbooks("MyFile.xlsm").activate
Range("j28").select
activecell.pastespecial xlPasteValues
range("").select appears not to work if the range is in a binary workbook but the macro is in a macro-enabled workbook.
You can/should avoid any uneccessary select/active (also copy/paste is not needed to just transfer values)
Option Explicit
Sub MyMacro()
Dim wsSrc as worksheet
Set wsSrc = workbooks("TheirFile.xlsb").worksheets(1) 'or ws name etc
If wsSrc.FilterMode Then
wsSrc.ShowAllData
End If
'various filters 'USE wsSrc not activesheet
'ThisWorkbook is the wb where your code is running...
ThisWorkbook.worksheets("sheetNameHere").range("J28").value = _
wsSrc.range("AW2").value
End Sub
Granted that I'm a newby.
I need to copy a specific cells area ("B6:C36") from a single worksheet (named "FILE MASTER") to all the other worksheets within the same workbook.
After that, I need to assign this brand new macro to a Button existing in the file master worksheet (therefore this macro has to have a name/sub otherwise I cannot assign it to a Button).
Having said that I tried to create a macro by using the recording feature of MS Excel, and it works. But it has a serious weakness: this automatedly encoding process has used/enunciated the name of every single worksheets in the source code. So if I add a new worksheet, this macro won't work correctly anymore.
Hope to have been enough clear
Thank you in advance to everybody.
You could change the code and try the below:
Option Explicit
Sub CopyYes()
Dim ws As Worksheet
With ThisWorkbook
'Copy the range
.Worksheets("FILE MASTER").Range("B6:C36").Copy
'Loop sheets
For Each ws In .Worksheets
With ws
'Avoid FILE MASTER
If .Name <> "FILE MASTER" Then
'Paste only values in A1 of each sheet
.Range("A1").PasteSpecial xlPasteValues
End If
End With
Next ws
End With
End Sub
Option Explicit
Sub CopyYes()
Dim ws As Worksheet
With ThisWorkbook
'Copy the range
.Worksheets("FILE MASTER").Range("B6:C36").Copy
'Loop sheets
For Each ws In .Worksheets
With ws
'Avoid FILE MASTER
If .Name <> "FILE MASTER" Then
'Paste values and formats in B6:C36 of each sheet
.Range("B6:C36").PasteSpecial xlPasteValues
.Range("B6:C36").PasteSpecial xlPasteFormats
End If
End With
Next ws
End With
End Sub
My goal is to take an excel document with variable row size, copy it and then paste it onto the bottom row of a new document.
Longer story, I need to take monthly sales reports and stack them into a larger excel file. Each month we make a variable number of sales. I need to aggregate all of these months together so we can process them.
I have some code that I thought worked below. It was able to move variable rows within different work sheets, but could not do the same for different work books.
Private Sub MoveRowToEndOfTable()
Dim LastRow As Long
LastRow = Cells.Find(What:="*", SearchOrder:=xlByRows,SearchDirection:=xlPrevious).Row
Sheets(1).Range("A2:A" & LastRow, "G2:G" & LastRow).Copy
Workbooks("BRN report Aggregator.xlsx").Worksheets("New shares EOM").Range("a6000").End(xlUp).Offset(1, 0).Cells.Insert
End Sub
I guess that your workbook is closed, check it before paste values (if workbook is closed ~> open it) :
Private Sub MoveRowToEndOfTable()
Dim LastRow As Long
LastRow = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Sheets(1).Range("A2:A" & LastRow, "G2:G" & LastRow).Copy
Dim wb As Workbook, wb_target As Workbook
'check if workbook is open already
For Each wb In Workbooks
If wb.Name = "BRN report Aggregator.xlsx" Then
Set wb_target = Workbooks("BRN report Aggregator.xlsx")
Exit For
End If
Next wb
'if not then open it
If wb_target Is Nothing Then
Set wb = Workbooks.Open("Path_to_file/BRN report Aggregator.xlsx")
End If
wb.Worksheets("New shares EOM").Range("a6000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll 'or xlPasteValues --depends on your needs
wb.Close True 'save and close if required
End Sub