Excel 查找文本并将相邻单元格复制到不同的工作表

我需要帮助。我需要搜索我的工作表并找到一个特定的单词（“物质”），然后将单元格2列中的值复制到另一张工作表中

例如，在表1中，如果在A4中发现“物质”，则将C4中的值复制并粘贴到最后一行下的表2中。我需要在整个工作表中继续这样做。“物质”不按顺序出现，但始终在A列中（即第一次出现可能是A4，下一次出现可能是A16）

以下是我目前掌握的情况：

Dim Cell, cRange As Range
    Set cRange = Sheets("Sheet1").Range("A1:A75")
    For Each Cell In cRange
    FindCounter = 0

    If Cell.Value = "Substances" Then
        FindCounter = FindCounter + 1
        Sheets("Sheet1").Cell.Value(0, 2).Copy
        Sheets("Sheet2").Range("A" & Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row + 1).PasteSpecial xlPasteValues
    End If
    Next

    Application.ScreenUpdating = True

---

试试这个。查找比循环更有效（原因我从未完全理解）

subx（）
Dim rFind作为范围，s作为字符串
带有板材（“板材1”）。范围（“A1:A75”）
设置rFind=.Find（What:=“Substances”，Lookat:=xlother，MatchCase:=False，SearchFormat:=False）
如果不是，那么rFind什么都不是
s=查找地址
做
图纸（“Sheet2”）.范围（“A”和图纸（“Sheet2”）.单元格（Rows.Count，“A”）.结束（xlUp）.行+1.Value=rFind.Offset（，2）.Value
设置rFind=.FindNext（rFind）
在rFind.Address s时循环
如果结束
以
端接头

使用for循环的备选方案：

Sub Copy()

    Dim i As Long
    Dim lRow1 As Long, lRow2 As Long
    Dim ws1 As Worksheet, ws2 As Worksheet

    'set worksheets
    Set ws1 = Sheets("Sheet1")
    Set ws2 = Sheets("Sheet2")

    'set last row to search for substances
    lRow1 = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row
    'start for loop
    For i = 1 To lRow1
        If ws1.Range("A" & i).Value = "Substances" Then
            'assuming you want to paste into column A on sheet 2
            'adjust as you need to
            lRow2 = ws2.Range("A" & ws2.Rows.Count).End(xlUp).Row + 1

            ws2.Range("A" & lRow2).Value = ws1.Range("A" & i).Offset(0, 2).Value
        End If
    Next
    'clear objects
    Set ws1 = Nothing
    Set ws2 = Nothing

End Sub

---

这些代码会发生什么，或者不会发生什么？有错误吗？我猜这是错误的

Sheets（“Sheet1”）.Cell.Value（0，2）。复制
？就用usgin
VLookUp
？看起来非常适合您的场景。我确实在代码行中遇到了一个错误：Sheets（“Sheet1”）.Cell.Value（0，2）。copy我非常感谢这两个选项。幸运（或不幸）的是，我没有收到错误消息，但由于某些原因，它不会复制/粘贴。
Sub Copy()

    Dim i As Long
    Dim lRow1 As Long, lRow2 As Long
    Dim ws1 As Worksheet, ws2 As Worksheet

    'set worksheets
    Set ws1 = Sheets("Sheet1")
    Set ws2 = Sheets("Sheet2")

    'set last row to search for substances
    lRow1 = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row
    'start for loop
    For i = 1 To lRow1
        If ws1.Range("A" & i).Value = "Substances" Then
            'assuming you want to paste into column A on sheet 2
            'adjust as you need to
            lRow2 = ws2.Range("A" & ws2.Rows.Count).End(xlUp).Row + 1

            ws2.Range("A" & lRow2).Value = ws1.Range("A" & i).Offset(0, 2).Value
        End If
    Next
    'clear objects
    Set ws1 = Nothing
    Set ws2 = Nothing

End Sub