![](/img/trans.png)
[英]VBA: Copy and Paste values only of a specific range and save in a new workbook
[英]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.