arks
arks

Reputation: 73

Loop gets stuck when copying and pasting linked worksheet

The first code works perfectly to loop through D23:J23 and change the date in cell D7 if one is available:

Sub Print_test()
    Dim i As Integer, VList As Variant, wshS As Worksheet, wbkT As Workbook, Count As Integer
    Dim c As Range
    
      For Each c In Sheets("InForceChgCalc").Range("D23:J23").Cells
        If c = "Y" Then
        Sheets("InForceChgCalc").Range("D7").Cells.Value = c.Offset(2, 0).Value
        MsgBox "counted" & c.Offset(2, 0).Value
        
        End If
        
        Next c          
          
End Sub

But when I take it a step further and copy/paste a linked worksheet from the active workbook into a newly created workbook, I get a "subscript out of range" error.

It runs through the first date correctly, but then gets stuck on the

Sheets("InForceChgCalc").Range("D7").Cells.Value = c.Offset(2, 0).Value

line with the aforementioned error.

Here is a snippet of that updated code to include copy/pasting:

  For Each c In Sheets("InForceChgCalc").Range("D48:J48").Cells
    If c = "Y" Then
    Sheets("InForceChgCalc").Range("D7").Cells.Value = c.Offset(2, 0).Value
    Sheets("InForceChangeNotice").Copy After:=wbkT.Worksheets(wbkT.Worksheets.Count)  ' Copies sheet (wshS) and places it after the latest sheet
    wbkT.Worksheets(wbkT.Worksheets.Count).Cells.Copy
    wbkT.Worksheets(wbkT.Worksheets.Count).Cells.PasteSpecial Paste:=xlPasteValues
           
    End If        

    Next c

The "InForceChangeNotice" tab is linked to cell D7 of the "InForceChgCalc" tab.

When the date changes in D7, I'd like to copy "InForceChangeNotice", paste it into the new workbook (cumulatively adding onto previous sheets), and then range-value the sheet.

Below is a picture of the "InForceChgCalc" tab for reference.

enter image description here

Upvotes: 0

Views: 47

Answers (1)

arks
arks

Reputation: 73

Simply add "ThisWorkbook.Activate" after the copy/paste code which activates the original workbook where the macro resides.

The loop gets stuck because the copy/paste occurs in a NEW workbook while it's trying to iterate in my original workbook so the "subscript is out of range"

  For Each c In Sheets("InForceChgCalc").Range("D48:J48").Cells
    If c = "Y" Then
    Sheets("InForceChgCalc").Range("D7").Cells.Value = c.Offset(2, 0).Value
    Sheets("InForceChangeNotice").Copy After:=wbkT.Worksheets(wbkT.Worksheets.Count)  ' Copies sheet (wshS) and places it after the latest sheet
    wbkT.Worksheets(wbkT.Worksheets.Count).Cells.Copy
    wbkT.Worksheets(wbkT.Worksheets.Count).Cells.PasteSpecial Paste:=xlPasteValues
    ThisWorkbook.Activate  
    End If        

    Next c

Upvotes: 0

Related Questions