Excel VBA：查找参数，将找到的行复制到另一个工作表（从特定单元格开始粘贴）

Question

每个工作表都有2个工作表（ UPDATED，CHANGES ），每列中的参数按可变顺序排列

UPDATED工作表具有以下列：

名称/价值/单位

更改工作表具有以下列：

状态/名称/值/单位

1. 首先，我搜索的变化与状态行：CHANGE
2. 然后我需要获取该行的名称
3. 要在UPDATED中找到它并复制整个行
4. 并将其复制到找到名称的状态列之后的位置

每个名称都是唯一的，但正如我之前提到的，位置可变，到目前为止，我的代码是：

Sub CopyRealChange()
Dim sh1 As Worksheet, sh2 As Worksheet
Dim lr As Long, r As Long, x As Long
Dim chng As Range
Set sh1 = ThisWorkbook.Worksheets("UPDATED")
Set sh2 = ThisWorkbook.Worksheets("CHANGES")

lr = sh2.Cells(Rows.Count, "A").End(xlUp).Row
x = 2
For r = 2 To lr
    If Range("A" & r).Value = "CHANGE" Then 'Evaluate the condition.
        'Sh2.Range("B" & x).Value = Sh1.Range("B" & r).Value 'Copy same Column location
        'FIND
        With Worksheets(2).Range("a1:a1000")
            Set chng = .Find(sh2.Range("B" & x).Value, LookIn:=xlValues)
            If chng Is Nothing Then
                sh1.Range(c).EntireRow.Copy Destination:=sh2.Range("B" & x)
            End If
        End With
        'FIND

    End If
    x = x + 1
Next r

结束子

因此，在此先感谢您为解决我的问题提供的帮助

---

与代码有关的问题在此行显示错误（在FIND中）

sh1.Range(c).EntireRow.Copy Destination:=sh2.Range("B" & x)

Answer 1

您的代码存在一些问题。

您没有声明要搜索的范围位于哪个工作表中。

If Range("A" & r).Value = "CHANGE" Then

您在一开始就声明了工作表，然后更改了在代码中引用它们的方式。

Set sh2 = ThisWorkbook.Worksheets("CHANGES")

With Worksheets(2).Range("a1:a1000")

这就是我为您准备的：使用简单循环检查值是否匹配并移动数据。

Sub CopyRealChange()

Dim sh1 As Worksheet, sh2 As Worksheet
Dim tempName As String
Dim lastRow1 As Long
Dim lastRow2 As Long

Set sh1 = ActiveWorkbook.Worksheets("UPDATED")
Set sh2 = ActiveWorkbook.Worksheets("CHANGES")

    lastRow1 = sh1.Cells(Rows.Count, "A").End(xlUp).Row    'Get last row for both sheets
    lastRow2 = sh2.Cells(Rows.Count, "A").End(xlUp).Row    'because you are searching both

    For s2Row = 2 To lastRow2                              'Loop through "CHANGES"
        If sh2.Cells(s2Row, 1).Value = "CHANGE" Then
            tempName = sh2.Cells(s2Row, 2).Value           'extra step for understanding concept
                                                           'There is a match, so now
            For s1Row = 2 To lastRow1                      'Search through the other sheet
                If sh1.Cells(s1Row, 1).Value = tempName Then                  
                    sh2.Cells(s2Row, 3).Value = sh1.Cells(s1Row, 2).Value    'Copy Values
                    sh2.Cells(s2Row, 4).Value = sh1.Cells(s1Row, 3).Value    
                End If
            Next s1Row
        End If
    Next s2Row
End Sub