Copying data from a referenced workbook-CodePudding

I am getting a subscript out of range error on the first if statement. I had this working when it was all within the same Workbook just different sheets I want it to reference a different workbook to gets it data from. I did the tools -> reference -> "Report" workbook that way I know it is open.

  Sub update_cell1_InProcess()
    
    Dim lRow As Long
    
     b = 31
    lRow = Workbooks("Report.xlsm").Sheets("CopyDatabase").Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 1 To lRow
       If Workbooks("Report.xlsm").Sheets("CopyDatabase").Cells(i, 5).Value = Workbooks("Big screen.xlsm").Sheets("CELL_1").Cells()(1, 2).Value Then   'B1
            If Workbooks("Report.xlsm").Sheets("CopyDatabase").Cells(i, 1).Value = Workbooks("Big screen.xlsm").Sheets("CELL_1").Cells()(1, 1).Value Then  'A1
                If Workbooks("Report.xlsm").Sheets("CopyDatabase").Cells(i, 6).Value <> "" Then 'not blank
                    If Workbooks("Report.xlsm").Sheets("CopyDatabase").Cells(i, 8).Value = "" Then
                    
                         Workbooks("Report.xlsm").Sheets("CopyDatabase").Rows(i).Copy

                        
                         Workbooks("Big screen.xlsm").Sheets("SHEET1").Activate
                       
                         Workbooks("Big screen.xlsm").Sheets("SHEET1").Cells(b   1, 1).Select
                        ActiveSheet.Paste
                        b = b   1
                    End If
                End If
            End If
          End If
        
        Next
        
    Application.CutCopyMode = False

End Sub

Just different If statements but code that worked in same workbook different sheets

Sub update_cell1_completed()

Dim lRow As Long

 b = 1
lRow = Cells(Rows.Count, 1).End(xlUp).Row

For i = 1 To lRow
   If Worksheets("TEST").Cells(i, 5).Value = Worksheets("CELL_1").Cells()(1, 2).Value Then  'B1
        If Worksheets("TEST").Cells(i, 1).Value = Worksheets("CELL_1").Cells()(1, 1).Value Then  'A1
            If Worksheets("TEST").Cells(i, 6).Value <> "" Then 'not blank
                If Worksheets("TEST").Cells(i, 8).Value <> "" Then 'not blank
                
                    Worksheets("TEST").Rows(i).Copy
                    
                    
                   Worksheets("SHEET1").Activate
                   
                    Worksheets("SHEET1").Cells(b   1, 1).Select
                    ActiveSheet.Paste
                    b = b   1
                End If
            End If
        End If
      End If
    
    Next
    
Application.CutCopyMode = False


End Sub

CodePudding user response：

Here's your code refactored to include proper object references and simply the multi-if statement. See if you get the same error, and if so, let us know which line is erroring for you:

EDIT: Per comments, updated references to Workbooks("Big screen.xlsm") to instead be ThisWorkbook

Sub update_cell1_InProcess()
    
    Dim wbRprt As Workbook: Set wbRprt = Workbooks("Report.xlsm")
    Dim wbScrn As Workbook: Set wbScrn = ThisWorkbook
    Dim wsDB As Worksheet:  Set wsDB = wbRprt.Worksheets("CopyDatabase")
    Dim wsC1 As Worksheet:  Set wsC1 = wbScrn.Worksheets("CELL_1")
    Dim wsS1 As Worksheet:  Set wsS1 = wbScrn.Worksheets("SHEET1")
    
    Dim lLastRow As Long:   lLastRow = wsDB.Cells(wsDB.Rows.Count, "A").End(xlUp).Row
    Dim lDestRow As Long:   lDestRow = 32
    
    Dim i As Long
    For i = 1 To lLastRow
        If wsDB.Cells(i, "E").Value = wsC1.Range("B1").Value _
        And wsDB.Cells(i, "A").Value = wsC1.Range("A1").Value _
        And Len(wsDB.Cells(i, "F").Value) > 0 _
        And Len(wsDB.Cells(i, "H").Value) > 0 Then
            wsDB.Rows(i).Copy wsS1.Cells(lDestRow, "A")
            lDestRow = lDestRow   1
        End If
    Next i
        
    Application.CutCopyMode = False

End Sub