Excel 如何使用VBA将包含特定文本的行复制到另一个工作表

我试图编写一个宏，如果一行中的单元格包含来自C列的文本（例如：孟买、德里等），则该宏将复制该行

例如，如果C列中有30行，但只有15行包含文本（孟买和德里）。我想复制这15行并将它们粘贴到“Sheet2”中 我正在使用下面的代码。然而，它只是模仿“孟买”。我需要for循环遍历同一列并复制“德里”

请让我知道如何使用和功能在上述代码。或以任何其他方式将其复制到图纸2中。

---

谢谢。

-p>试着做一个for循环

-从第1页复制到第2页的示例

Dim i As Long
Dim sh As Worksheet
dim sh2 As worksheet
Set sh = ThisWorkbook.Sheets("Sheet1")
Set sh2= ThisWorkbook.Sheets("Sheet2")
For i = 1 To Application.CountA( sh.Range("C:C"))

-通过定义if语句，可以控制复制的值

-在循环中生成if语句，控制值是否为空

-引用具有循环值的单元格

-副本：）

如果sh.Range（“C”&i）.Value为“”，则
sh.Range（“C”和i）.副本（sh2）
如果结束
接下来我

请尝试下一个代码。您必须使用您的旧图纸名称：

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

它应该非常快，将要复制的行保持在联合范围内，并立即粘贴所有内容

---

如果您不需要rows格式，它甚至会更有效。可以使用数组。而且不是要复制的整行，只是它的填充部分…

最后一行计算的范围处理方式不是最好的。如果有空行/单元格，则将丢失行。然后，您的代码不会搜索任何字符串（如Mumbai…）。无需检查是否为空。将只处理具有要搜索的字符串值的单元格。然后他需要复制所有行，最后复制每个单元格并不是最有效的方法，因为其他方法（一次复制）更好…我想你需要的不是“孟买和德里”，而是“孟买”或“德里”。。。我的假设正确吗？我需要孟买和德里都被复制。

if sh.Range("C" & i).Value <> "" then

sh.Range("C" & i).Copy (sh2)

end if

Next i

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