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

Excel VBA: Find parameter, copy found row to another Worksheet (pasting starting at specific cell)

提问by Zegad

Having 2 Worksheets (UPDATED,CHANGES) each one have parameters in each column in variable order

有 2 个工作表 ( UPDATED,CHANGES)，每个工作表在每一列中都有可变顺序的参数

UPDATEDWorksheet has the columns:

更新的工作表具有以下列：

Name / Value / Units

名称/值/单位

CHANGESWorksheet has the columns:

更改工作表具有以下列：

Status / Name / Value / Units

状态/名称/价值/单位

1. So first I search in CHANGESa row with the Status: CHANGE
2. Then I need to get the Nameof that row
3. To find it in UPDATEDand copy the whole Row
4. And copy it in the position after the column Statuswhere the name was found

1. 所以首先我在CHANGES 中搜索状态为CHANGE的一行
2. 然后我需要获取该行的名称
3. 在UPDATED 中找到它并复制整行
4. 并将其复制到找到名称的列状态之后的位置

Each Name is unique but as I mentioned before has a variable position, my code so far:

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

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

End Sub

结束子

So thanks in advance for the help to resolve my problem

所以在此先感谢您帮助解决我的问题

---

---

Concerns with the code show an error at this line (in the FIND)

对代码的关注在此行显示错误（在 FIND 中）

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

采纳答案by peege

There are a few issues with your code.

您的代码存在一些问题。

You didn't declare with which worksheet the range you are searching for is located.

您没有声明您要搜索的范围所在的工作表。

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

You declared the worksheets in the beginning then change how you reference them in the code.

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

Set sh2 = ThisWorkbook.Worksheets("CHANGES")

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

Here is what I've got for you:using simple loops checking to see if values match and move data.

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

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