繁体   English   中英

Excel VBA-仅复制在其他工作簿上的列中包含特定值的行范围

[英]Excel VBA - copy only row-range that contains specific value in column on a different workbook

我想创建一个宏,如果DA列中的单元格包含特定值,则该宏将复制行范围。

例如:

如果列DA10包含值3不完整 ,则N10 包含任何值,CI10不包含任何内容-则宏应将单元格F10,H10和DA10复制到工作簿reportWB中 我不知道该怎么做。

到目前为止的进展(感谢Shai-我仍然要使它工作起来很愚蠢):

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, 5) = "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

仍然不起作用。 在检查列DA之后结束。

您需要添加代码部分,将单元格的文本与“ 3-incompletion”进行比较。 您可以使用InStr函数来实现此目的。

With dataWB.Sheets("Data")
    ' === not sure why you want to look for the last row ??? ===
    'LastRow7 = .Cells(.Rows.Count, "F").End(xlUp).Row

    ' compare the value in row 10 (as in your post example)
    LastRow7 = 10

     If InStr(.Range("AD" & LastRow7).Value2, "3-incompletion") > 0 And _
        Trim(.Range("AD" & 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

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM