我正在尝试编写一个宏,如果该行中的某个单元格包含来自C列的文本(例如,孟买,德里等),则该行将复制该行。
例如,如果在C列中有30行,但只有15行包含文本(孟买和德里)。我想复制这15行并将其粘贴到“ Sheet2”中,我在使用以下代码。但是它正在复制所有填充的行。但是我的要求是代码只需要将a,b,c,d,f,g,h,i,l和m的列复制到Sheet2。
Sub testPasteinSh2()
Dim sh1 As Worksheet, sh2 As Worksheet, rng As Range, cel As Range
Dim rngCopy As Range, lastR1 As Long, lastR2 As Long
Dim strSearch1 As String, strSearch2 As String
strSearch1 = "Mumbai" 'or combo value...
strSearch2 = "Delhi" 'or something else...
Set sh1 = ActiveSheet 'use here your worksheet
Set sh2 = Worksheets("Sheet2") 'use here your sheet
lastR1 = sh1.Range("C" & Rows.count).End(xlUp).Row
lastR2 = sh2.Range("A" & Rows.count).End(xlUp).Row + 1
Set rng = sh1.Range("C2:C" & lastR1)
For Each cel In rng.cells
If cel.Value = strSearch1 Or cel.Value = strSearch2 Then
If rngCopy Is Nothing Then
Set rngCopy = sh1.Rows(cel.Row)
Else
Set rngCopy = Union(rngCopy, sh1.Rows(cel.Row))
End If
End If
Next
If Not rngCopy Is Nothing Then
rngCopy.Copy Destination:=sh2.cells(lastR2, 1)
End If
End Sub
你能帮我么。先感谢您。
提出一个明确的问题似乎很困难。
碰巧我从上一个问题知道您的需求。假设您没有改变主意,请测试以下代码:
Sub testPasteinSh2Bis()
Dim sh1 As Worksheet, sh2 As Worksheet, rng As Range, cel As Range
Dim rngCopy As Range, lastR1 As Long, lastR2 As Long
Dim strSearch1 As String, strSearch2 As String
'a, b, c, d, f, g, h, i, l 'columns to be copied
strSearch1 = "Mumbai" 'or combo value...
strSearch2 = "Delhi" 'or something else...
Set sh1 = ActiveSheet 'use here your worksheet
Set sh2 = sh1.Next 'use here your sheet
lastR1 = sh1.Range("C" & Rows.count).End(xlUp).Row
lastR2 = sh2.Range("A" & Rows.count).End(xlUp).Row + 1
Set rng = sh1.Range("C2:C" & lastR1)
For Each cel In rng.cells
If cel.Value = strSearch1 Or cel.Value = strSearch2 Then
If rngCopy Is Nothing Then
Set rngCopy = sh1.Range(sh1.Range("A" & cel.Row & ":D" & cel.Row).Address & "," & _
sh1.Range("F" & cel.Row & ":I" & cel.Row).Address & "," & sh1.Range("L" & cel.Row).Address)
Else
Set rngCopy = Union(rngCopy, sh1.Range(sh1.Range("A" & cel.Row & ":D" & cel.Row).Address & "," & _
sh1.Range("F" & cel.Row & ":I" & cel.Row).Address & "," & sh1.Range("L" & cel.Row).Address))
End If
End If
Next
If Not rngCopy Is Nothing Then
rngCopy.Copy Destination:=sh2.cells(lastR2, 1)
End If
End Sub
它应该为匹配的情况复制a,b,c,d,f,g,h,i,l列...
本文收集自互联网,转载请注明来源。
如有侵权,请联系 [email protected] 删除。
我来说两句