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

我想从工作簿15B2[...]" (sheet DATA) data复制数据到worbook。我从(sheet getDATA)开始macros。macros应该复制列F ， H和DA的单元格第N列的细胞CI为空白，第DA列的值为3-Incompletion 。

不知怎的，macros在第二个if语句后停下来， End 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 

我不知道这个function到底是什么。 它是否在每一行查看并计数符合条件的行？

这里是完整的代码：

 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

就像我可以从你的问题中明确你的意图，你的代码和上面的评论下面的程序应该做你想要的。 它没有经过testing，但它可能包含的任何错误应该是小的，你可以很容易地修复（或在这里指出）。

第一个程序在检查最后一行之后复制数据块。 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