查找、选择和复制行

Question

如何在某列中找到包含某个字符串的单元格，然后选择整行并使用 Excel vba 复制该行？

我对使用 Excel VBA 比较陌生，并且花了几天时间尝试自己编写代码。 我正在处理将不同数据集复制到其中的工作表。每个数据集都将在 A 列的某个单元格中包含字符串“page”，但是该行因数据集而异。我现在需要一些 vba 代码来首先识别包含字符串“Page”的列 A 的单元格，然后选择整行并将其复制到表的最后一行下方（其行数也不同）。我已经设法编写了一些将整行复制到表格底部的代码，因此我也可以重用该代码，主要问题是识别包含字符串的正确行。 有人可以帮我解决这个问题吗？

提前致谢！

Answer 1

你可以试试：

Sub test()

    Dim strSearch As String
    Dim ColumnNo As Long, LastRow As Long
    Dim rngFound  As Range
    Dim wsDestination As Worksheet, wsSource As Worksheet
    
    'set worksheets
    With ThisWorkbook
        Set wsSource = .Worksheets("Sheet1")
        Set wsDestination = .Worksheets("Overview")
    End With
    
    'Set the value you want to search
    strSearch = "*Page*"
    
    'Set the column you want to seach
    ColumnNo = 1
    
    'Create a with statement to point Sheet1.
    With wsSource
        
        'Search for strSearch in column number ColumnNo
        Set rngFound = .Columns(ColumnNo).Find(strSearch, LookIn:=xlValues, lookat:=xlWhole)
        
        If Not rngFound Is Nothing Then
            LastRow = wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp).Row + 1
            'Copy row.
            .Rows(rngFound.Row).EntireRow.Copy
            'Paste row
            wsDestination.Rows(LastRow).PasteSpecial Paste:=xlPasteValues
            'Delete row
            .Rows(rngFound.Row).EntireRow.Delete Shift:=xlUp
        Else
            'Msg box
            MsgBox "Value not found."
        End If
        
    End With
      
End Sub

Answer 2

这是一个代码，用于将整个行从名为 Sheet1 的工作表复制到另一个名为 Sheet2 的工作表，条件为“页面”

Private Sub test()
Dim i As Integer, lastrow As Integer, newrow As Integer
lastrow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To lastrow
If Worksheets("Sheet1").Range("A" & i) Like "*" & "Page" & "*" Then
Worksheets("Sheet1").Range("A" & i).EntireRow.Copy
Worksheets("Sheet2").Activate
newrow = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Worksheets("Sheet2").Cells(newrow, 1).Select
ActiveSheet.Paste
End If
Next i
End Sub