从引用的工作簿复制数据

Question

我在第一个 if 语句中收到下标超出范围错误。 当它都在同一个工作簿中时，我有这个工作，只是不同的工作表我希望它引用不同的工作簿来从中获取数据。 我做了工具->参考->“报告”工作簿，我知道它是打开的。

  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

只是不同的 If 语句，但在同一工作簿不同工作表中工作的代码

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

Answer 1

这是您的代码重构以包括正确的对象引用和简单的多 if 语句。 看看你是否得到同样的错误，如果是，让我们知道哪一行是你的错误：

编辑：根据评论，更新对Workbooks("Big screen.xlsm")的引用改为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