根据3个标准​​从不同的工作簿中复制

Question

我想将工作簿15B2[...]" (sheet DATA)中的数据复制到worbook。我从(sheet getDATA)启动宏。如果列F，H中的单元格为空且列DA，则宏应复制列N，CI和DA中的单元格其中包含值 3-Incompletion 。

不知何故，宏在第二个if语句后停止，直接转到End if而不复制任何内容：

If InStr(.Range("DA" & LastRow7).Value2, "3-Incompletion") > 0 
And Trim(.Range("N" & LastRow7).Value2) = "" 
And Trim(.Range("CI" & LastRow7).Value2) = "" Then

我不确切知道这个功能是做什么的。它是否会在每一行中查找并计算符合条件的行？

以下是完整的代码：

Sub insertINCOMPLETION()

Dim dataWB As Workbook
Dim reportWB As Workbook
Dim workB As Workbook
Dim incomplRNG As Range
Dim LastRow6 As Long
Dim LastRow7 As Long

For Each workB In Application.Workbooks
    If Left(workB.Name, 4) = "15B2" Then
        Set dataWB = workB
        Exit For
    End If
Next

If Not dataWB Is Nothing Then
    Set reportWB = ThisWorkbook

    With reportWB.Sheets("getDATA")
        LastRow6 = .Cells(.Rows.Count, "B").End(xlUp).Offset(1).Row
    End With

    With dataWB.Sheets("Data")
        LastRow7 = .Cells(.Rows.Count, "F").End(xlUp).Row

        If InStr(.Range("DA" & LastRow7).Value2, "3-Incompletion") > 0 
        And Trim(.Range("N" & LastRow7).Value2) = "" 
        And Trim(.Range("CI" & LastRow7).Value2) = "" Then
            Set incomplRNG = Application.Union(.Range("F8:F" & _ 
            LastRow7),.Range("H8:H" & LastRow7), .Range("DA8:DA" & LastRow7))
            incomplRNG.Copy
            reportWB.Sheets("getDATA").Range("B" & LastRow6).PasteSpecial xlPasteValues
        End If
    End With
End If

End Sub

我需要帮助来解决这个问题，因为我不擅长编程VBA。

Answer 1

尽可能接近你的问题，你的代码和上面的评论你的意图，下面的程序应该做你想要的。它没有经过测试，但它可能包含的任何错误应该是可以轻松修复的小错误（或者在这里指出它们）。

第一个过程在检查数据块的最后一行后复制数据块。 Version_2检查每一行，只复制那些符合标准的行。

Option Explicit

Sub insertINCOMPLETION()

    Dim DataWb As Workbook
    Dim ReportWB As Workbook
    Dim LastReportRow As Long
    Dim LastDataRow As Long

    For Each DataWb In Application.Workbooks
        If InStr(1, DataWb.Name, "15B2", vbTextCompare) = 1 Then Exit For
    Next

    If Not DataWb Is Nothing Then
        Set ReportWB = ThisWorkbook
        With ReportWB.Sheets("getDATA")
            LastReportRow = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
        End With

        With DataWb.Sheets("Data")
            LastDataRow = .Cells(.Rows.Count, "F").End(xlUp).Row

            If (InStr(1, .Range("DA" & LastDataRow).Value2, "3-Incompletion", vbTextCompare) > 0) And _
                    (Trim(.Range("N" & LastDataRow).Value2) = "") And _
                    (Trim(.Range("CI" & LastDataRow).Value2) = "") Then
                .Range("F8:F" & LastDataRow).Copy ReportWB.Sheets("getDATA").Range("B" & LastReportRow)
                .Range("H8:H" & LastDataRow).Copy ReportWB.Sheets("getDATA").Range("C" & LastReportRow)
                .Range("DA8:DA" & LastDataRow).Copy ReportWB.Sheets("getDATA").Range("D" & LastReportRow)
            End If
        End With
    End If
End Sub

Sub insertINCOMPLETION_Version_2()

    Dim DataWb As Workbook
    Dim ReportWB As Workbook
    Dim LastReportRow As Long
    Dim LastDataRow As Long
    Dim R As Long

    For Each DataWb In Application.Workbooks
        If InStr(1, DataWb.Name, "15B2", vbTextCompare) = 1 Then Exit For
    Next

    If Not DataWb Is Nothing Then
        Set ReportWB = ThisWorkbook
        With ReportWB.Sheets("getDATA")
            LastReportRow = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
        End With

        With DataWb.Sheets("Data")
            LastDataRow = .Cells(.Rows.Count, "F").End(xlUp).Row

            Application.ScreenUpdating = False
            For R = 8 To LastDataRow
                If (InStr(1, .Cells(R, "DA").Value2, "3-Incompletion", vbTextCompare) > 0) And _
                        (Trim(.Cells(R, "N").Value2) = "") And _
                        (Trim(.Cells(R, "CI").Value2) = "") Then
                    ReportWB.Sheets("getDATA").Cells(LastReportRow, "B").Value = .Cells(R, "F").Value
                    ReportWB.Sheets("getDATA").Cells(LastReportRow, "C").Value = .Cells(R, "H").Value
                    ReportWB.Sheets("getDATA").Cells(LastReportRow, "D").Value = .Cells(R, "DA").Value
                    LastReportRow = LastReportRow + 1
                End If
            Next R
            Application.ScreenUpdating = True
        End With
    End If
End Sub