vba - 如何将包含某些文本的单元格复制到另一个工作表

Question

我正在尝试将满足特定条件的单元格复制到新工作表中。

例如，如果 Worksheet(1) 上的单元格 H15 包含请求的值 ( 1234 )，那么是否仅将单元格 A15、B15、C15、F15 和包含文本字符串的单元格复制到新工作表上的新行中？

我希望能够扫描一个范围，比如 M1:X155 并为每个找到的值（1234）将上述单元格复制到一个新的工作表中。

标签： vbaexcel

Answer 1

根据评论，我已将代码修改为仅复制指定范围，两个表格都应该存在，代码不会为您创建第二个表格：

Sub Test()
Dim Cell As Range

With Sheets("Sheet1") 'Sheet with data to check for value
    ' loop column H untill last cell with value (not entire column)
    For Each Cell In .Range("H1:H" & .Cells(.Rows.Count, "H").End(xlUp).Row)
        If Cell.Value = "1234" Then
            NextFreeRow = Sheets("Sheet2").Cells(Sheets("Sheet2").Rows.Count, "A").End(xlUp).Row + 1
             'get the next empty row to paste data to
            .Range("A" & Cell.Row & ",B" & Cell.Row & ",C" & Cell.Row & ",F" & Cell.Row).Copy Destination:=Sheets("Sheet2").Range("A" & NextFreeRow)
        End If
    Next Cell
End With
End Sub

更新：

下面的代码将在 H 列的每个单元格内搜索文本“1234”，如果找到，它将复制您想要的范围。

Sub Test()
Dim Cell As Range

With Sheets("Sheet1") 'Sheet with data to check for value
    ' loop column H untill last cell with value (not entire column)
    For Each Cell In .Range("H1:H" & .Cells(.Rows.Count, "H").End(xlUp).Row)
        pos = InStr(Cell.Value, "1234")
        If pos > 0 Then
            NextFreeRow = Sheets("Sheet2").Cells(Sheets("Sheet2").Rows.Count, "A").End(xlUp).Row + 1
             'get the next empty row to paste data to
            .Range("A" & Cell.Row & ",B" & Cell.Row & ",C" & Cell.Row & ",F" & Cell.Row & "," & Cell.Address).Copy Destination:=Sheets("Sheet2").Range("A" & NextFreeRow)
        End If
    Next Cell
End With
End Sub