最新消息:雨落星辰是一个专注网站SEO优化、网站SEO诊断、搜索引擎研究、网络营销推广、网站策划运营及站长类的自媒体原创博客

excel - how to prevent when a 2nd workbook opened, it blows up code, running on the timer, in another previous opened workbook -

programmeradmin6浏览0评论

WB1 works fine by itself. A WB1 sheet obtains stock option data from RDT, and writes that data to another worksheet on a timer interval. When the timer in WB1 is invoked, the first thing it does is 'select' the sheet capturing the RDT, named "RTD" so its current data can be copied and pasted to a sheet that keeps the RTD data for the current day. The number of rows in RTD can be changed during the day. Therefore, for each copy it has code to determine the current first and last rows that are currently in the RTD sheet. When I open a 2nd WB, WB2, not related or connected to WB1 in any way and create a new sheet it blows up the code running on the timer in WB1, huh?

why would opening a 2nd workbook and manually creating a new sheet cause an error in the first workbook code running on the timer? see images below

here is most of the code, please bear with all the commented out code that I use for testing

Sub saveRTDinfo()
    
    'copy a dynamic range to the end of sheet where copied data is kept
    'first get source range of cells to copy
    Dim x, rowA, rowB, colA, colB As String
    'don't need target sheet start column, assume target column is 1
    'don't need target sheet start row, assume target row is 2
    'MsgBox destSheet
    'destSheet = "040624" 'destSheet now set todays date when excel starts
    
    Sheets("RTD").Select
    Sheets("RTD").Activate
    
    'Set wb1RTD = ThisWorkbook.Sheets("RTD")
    'Set wb1dest = ThisWorkbook.Sheets("021225")
    
    On Error Resume Next
    copyRowEnd = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    
    lastRow = Range("A" & Rows.Count).End(xlUp).Row
    lastRow = Cells.Find(What:="*", _
                    After:=Range("A1"), _
                    LookIn:=xlFormulas, _
                    LookAt:=xlPart, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious).Row
    Resume Next
    Dim rng As Range, cell As Range
    
    'Set rng = Range("A1:A10")

    copyColEnd = Cells.Find(What:="*", _
                    After:=Range("A1"), _
                    LookIn:=xlFormulas, _
                    LookAt:=xlPart, _
                    SearchOrder:=xlByColumns, _
                    SearchDirection:=xlPrevious).Column
    On Error GoTo 0
    'MsgBox "Last used Col number: " & copyColEnd
    'build and copy range of current cells (range repeats to get values over time)
    'range always starts r2c1 to allow for column titles
    copyRowStart = 2
    copyColStart = 1
    Range(Cells(copyRowStart, copyColStart), Cells(copyRowEnd, copyColEnd)).Copy
    'ActiveSheet.(Cells(1, 1),CELLS(2,1)).Copy

    'now set up target start cell to copy range, values only
    Sheets(destSheet).Select
    Sheets(destSheet).Activate
    'paste into first unused row, always column 1
    destRowStart = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

    destRowStart = destRowStart + 1
    
    destColStart = 1
    ActiveSheet.Cells(destRowStart, destColStart).PasteSpecial Paste:=xlPasteValues
    ' wb1dest.Cells(destRowStart, destColStart).PasteSpecial Paste:=xlPasteValues
    
    'Range(Cells(lastRow, 1), Cells(2, 1)).PasteSpecial Paste:=xlPasteValues
    'PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
     ':=False, Transpose:=False

End Sub

WB1 works fine by itself. A WB1 sheet obtains stock option data from RDT, and writes that data to another worksheet on a timer interval. When the timer in WB1 is invoked, the first thing it does is 'select' the sheet capturing the RDT, named "RTD" so its current data can be copied and pasted to a sheet that keeps the RTD data for the current day. The number of rows in RTD can be changed during the day. Therefore, for each copy it has code to determine the current first and last rows that are currently in the RTD sheet. When I open a 2nd WB, WB2, not related or connected to WB1 in any way and create a new sheet it blows up the code running on the timer in WB1, huh?

why would opening a 2nd workbook and manually creating a new sheet cause an error in the first workbook code running on the timer? see images below

here is most of the code, please bear with all the commented out code that I use for testing

Sub saveRTDinfo()
    
    'copy a dynamic range to the end of sheet where copied data is kept
    'first get source range of cells to copy
    Dim x, rowA, rowB, colA, colB As String
    'don't need target sheet start column, assume target column is 1
    'don't need target sheet start row, assume target row is 2
    'MsgBox destSheet
    'destSheet = "040624" 'destSheet now set todays date when excel starts
    
    Sheets("RTD").Select
    Sheets("RTD").Activate
    
    'Set wb1RTD = ThisWorkbook.Sheets("RTD")
    'Set wb1dest = ThisWorkbook.Sheets("021225")
    
    On Error Resume Next
    copyRowEnd = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    
    lastRow = Range("A" & Rows.Count).End(xlUp).Row
    lastRow = Cells.Find(What:="*", _
                    After:=Range("A1"), _
                    LookIn:=xlFormulas, _
                    LookAt:=xlPart, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious).Row
    Resume Next
    Dim rng As Range, cell As Range
    
    'Set rng = Range("A1:A10")

    copyColEnd = Cells.Find(What:="*", _
                    After:=Range("A1"), _
                    LookIn:=xlFormulas, _
                    LookAt:=xlPart, _
                    SearchOrder:=xlByColumns, _
                    SearchDirection:=xlPrevious).Column
    On Error GoTo 0
    'MsgBox "Last used Col number: " & copyColEnd
    'build and copy range of current cells (range repeats to get values over time)
    'range always starts r2c1 to allow for column titles
    copyRowStart = 2
    copyColStart = 1
    Range(Cells(copyRowStart, copyColStart), Cells(copyRowEnd, copyColEnd)).Copy
    'ActiveSheet.(Cells(1, 1),CELLS(2,1)).Copy

    'now set up target start cell to copy range, values only
    Sheets(destSheet).Select
    Sheets(destSheet).Activate
    'paste into first unused row, always column 1
    destRowStart = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

    destRowStart = destRowStart + 1
    
    destColStart = 1
    ActiveSheet.Cells(destRowStart, destColStart).PasteSpecial Paste:=xlPasteValues
    ' wb1dest.Cells(destRowStart, destColStart).PasteSpecial Paste:=xlPasteValues
    
    'Range(Cells(lastRow, 1), Cells(2, 1)).PasteSpecial Paste:=xlPasteValues
    'PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
     ':=False, Transpose:=False

End Sub
Share edited Mar 10 at 7:54 FunThomas 30.1k4 gold badges23 silver badges38 bronze badges asked Mar 9 at 20:18 robert betzrobert betz 696 bronze badges 5
  • 4 Without a qualifier to identify the workbook in question, VBA is going to assume that it's referring to the ActiveWorkbook. Since you're in a workbook without the "Sheets("RDT") in it, the code breaks. – Frank Ball Commented Mar 9 at 20:32
  • 1 Please share in detail what "running on the timer" means and its (all) code. – VBasic2008 Commented Mar 9 at 22:55
  • the code in the sub, saveRTDinfo(), is what runs on the timer. at the start of that code, there is these statements, Sheets("RTD").Select Sheets("RTD").Activate, which I thought would make the workbook containing the RTD sheet the active workbook by default – robert betz Commented Mar 10 at 20:51
  • Once you open a workbook (file), it becomes the active workbook (ActiveWorkbook). When you don't qualify a sheet with a workbook (e.g. Sheets("RTD")), it is considered a sheet in the active workbook. To ensure a code runs on the workbook containing the code, reference it (qualify its sheets) with ThisWorkbook (e.g. ThisWorkbook.Sheets("RTD")). – VBasic2008 Commented Mar 10 at 21:04
  • thanks for the code sample vbasic2008, I will try it out, amazing how much less code that is compared to what I came up with – robert betz Commented Mar 10 at 21:06
Add a comment  | 

1 Answer 1

Reset to default 1

Append Values from One Sheet to Another

Sub saveRTDinfo()
    ' Copies current RTD info to today's sheet.
    
    ' Define constants.
    Const SRC_SHEET_NAME As String = "RTD"
    Const DST_DATE_FORMAT As String = "mmddyy"
    
    ' Workbook
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Source
    Dim sws As Worksheet: Set sws = wb.Sheets(SRC_SHEET_NAME)
    Dim srg As Range, sRowsCount As Long
    With sws.Range("A1").CurrentRegion ' whole table (has headers)
        sRowsCount = .Rows.Count - 1
        If sRowsCount < 1 Then Exit Sub ' no data, only headers or nothing
        Set srg = .Resize(sRowsCount).Offset(1) ' only data (no headers)
    End With

    ' Destination
    Dim dSheetName As String: dSheetName = Format(Date, DST_DATE_FORMAT)
    Dim dws As Worksheet: Set dws = wb.Sheets(dSheetName)
    Dim drg As Range:
    With dws.Range("A1").CurrentRegion ' whole table (has headers)
        ' leftmost cell below data resized to source range:
        Set drg = .Cells(1).Offset(.Rows.Count) _
            .Resize(sRowsCount, srg.Columns.Count)
    End With
    
    ' Copy values.
    drg.Value = srg.Value
    
    ' Save.
    wb.Save
    
End Sub

与本文相关的文章

发布评论

评论列表(0)

  1. 暂无评论