在Excel中使用VBA查找所有包含特定文本的内容，并复制粘贴到新工作表

我是VBA新手，正在尝试在我的报价工作表中重新创建“查找所有”函数，以复制和粘贴B列（B30和B350之间）中包含CB（文本中间）的任何行，并将其复制和粘贴到新工作表（工单）中，以在AA列制定明细表

Sub CreateWorkOrder()
 Dim quote As Worksheet
 Dim Work_Order As Worksheet
 Dim CB As String
 Dim finalrow As Integer
 Dim i As Integer

Set quote = Sheet1
Set Work_Order = Sheet10
CB = quote.Range("B2").Value
number = "*, CB*"

'goto sheet and start searching and copying
quote.Select
finalrow = 350

'loop through the rows to find the matching records
For i = 30 To finalrow

If Cells(i, 2) = CB Then
    Range(Cells(i, 1), Cells(i, 2)).Copy
    Work_Order.Select
    Range("AA300").End(xlUp).Offset(1, 0).PasteSpecial xlpastevalue
    Range("AA" & i + 1).PasteSpecial xlPasteValues
    quote.Select
    End If
Next i
Work_Order.Select
Range("B21").Select
End Sub

我得到了一个特殊的range类方法，但在

---

Range（“AA300”）.End（xlUp）.Offset（1，0）.粘贴特殊的xlpastevalue
通常不需要使用
。选择
，最好

试试这个：

Sub CreateWorkOrder()
Dim quote As Worksheet
Dim Work_Order As Worksheet
Dim CB As String
Dim finalrow As Integer
Dim i As Integer

Set quote = Sheet1
Set Work_Order = Sheet10
CB = quote.Range("B2").Value
Number = "*, CB*"

finalrow = 350

'loop through the rows to find the matching records
For i = 30 To finalrow
    If quote.Cells(i, 2) = CB Then
        quote.Range(quote.Cells(i, 1), quote.Cells(i, 2)).Copy
        Work_Order.Range("AA300").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        Work_Order.Range("AA" & i + 1).PasteSpecial xlPasteValues
    End If
Next i
'  Leaving in the below just so it goes to a sheet
'  and selects the cell for the user.
Work_Order.Activate
Work_Order.Range("B21").Select
End Sub

避免循环的自动筛选方法：

Sub CreateWorkOrder()

    Dim quote As Worksheet
    Dim Work_Order As Worksheet
    Dim CB As String

    Set quote = Sheet1
    Set Work_Order = Sheet10
    CB = quote.Range("B2").Value
    If Len(CB) = 0 Then Exit Sub    'No criteria

    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    With quote.Range("B29", quote.Cells(quote.Rows.Count, "B").End(xlUp))
        If .Row = 29 And .Rows.Count > 1 Then
            .AutoFilter 1, "*" & CB & "*"
            Intersect(.Parent.Range("A:B"), .Offset(1).EntireRow).Copy
            Work_Order.Cells(Work_Order.Rows.Count, "AA").End(xlUp).Offset(1).PasteSpecial xlPasteValues
            Application.CutCopyMode = False
            .AutoFilter
        End If
    End With

    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
        .EnableEvents = True
    End With

End Sub

这对我来说没有任何结果。我在行中添加了一个隐藏文本，以便它跳过，但这不起作用。我确实将行If quote.Cells（I，2）更改为If quote，Cells（I，1），它将粘贴所有内容。我似乎缺少了只查找以CB开头的数字的筛选器部分。有没有办法忽略隐藏行？@kassiestrom-要忽略隐藏行，在你的
for I
循环中，可能需要执行
If quote.Cells（I，2）.EntireRow.hidden=False，然后//If quote.Cells（I，2）=CB…
在哪里指定循环应搜索的内容？它是复制和粘贴页面上的所有信息，而不仅仅是包含CB的行