我想使用VBA将包含特定文本的特定行复制到另一张纸上

沙利尼

我正在尝试编写一个宏,如果该行中的某个单元格包含来自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] 删除。

编辑于
0

我来说两句

0 条评论
登录 后参与评论

相关文章

在特定行上搜索值,将整列复制到另一张纸上

将满足条件的特定行复制到另一张纸上

将包含特定单词的单元格复制到另一张纸上的单元格

使用 vba 宏代码将特定列从一张纸复制到另一张纸

将范围复制到另一张纸上

给定行实例,将整行复制到另一张纸上

VBA Excel将行从一张工作表复制到另一张工作表中具有特定值的行

如何使用IF AND Macro将单元格复制到另一张纸上?

使用VBA,将所有公式从一张纸复制到另一张纸上,而没有其他内容?

使用VBA将一行从一张纸复制到另一张纸

我正在尝试将4个数据透视表的rowlabel一张一张地复制到另一张纸上

如何使用VBA按照预定顺序将一张纸之间的值复制到另一张纸并将其粘贴到另一张纸上?

忽略公式时,仅将包含数据的行复制到另一张纸上的最后一个空行

查找具有特定标题的数据,并将整列复制到另一张纸上

如何有条件地将一行复制到另一张纸上?

根据下拉菜单中的选择将数据复制到另一张纸上

将1列经过过滤的数据复制到另一张纸上

vba循环,以便将特定单元格从一张纸复制到另一张纸

将数据匹配从一张工作表复制到特定行范围内的另一张工作表 Google 应用脚本

如何将特定行从一张纸复制到另一张纸(Google Apps脚本)

VBA - 将数据从一张纸复制到另一张纸

无法使用VBA将整行从一张纸复制到另一张纸

VBA,使用标题名称将值从一张纸复制到另一张纸

使用 vba 以相反的顺序将数据从一张纸复制到另一张纸

使用VBA将数据从一张纸复制到另一张纸时出错

使用VBA将值从一张纸复制到另一张纸

将Excel行从一张纸复制到另一张纸

将行从一张纸复制到另一张纸

将单元格复制到另一张纸上,并自动填充复制的单元格10次