如何通过匹配单元格值将范围复制并粘贴到另一个工作表

How to copy and paste a range to another worksheet by matching a cell value

我需要将一个范围从一个作品sheet复制到另一个作品sheet,方法是将一个单元格中的值与另一个sheet中具有该值的行相匹配。例如,我需要通过将单元格 A2 (sheet1) 中的值与 sheet2 上具有匹配单元格的行相匹配来复制 sheet1 上的范围 E2:H2价值。例如,在我下面的图片中,sheet1 的 ID 为 10 和一些数据。 E2:H2 列应复制到 sheet2 上 ID 为 10 的行。

Sheet1 示例(数据来源)

Sheet2 示例(数据目标)

这将是调用此子程序的更大代码的一部分,我做了一个示例而不是使用实际的传播sheet,因为数据的大小。

这里是一些修改后的代码,与我目前对这段代码的代码非常相似(更改了范围和 sheets 名称)。我知道我要粘贴的东西不会做我想要的,但找不到与我需要的东西类似的东西。谢谢!

sub copydata()
    'Range of cells to be copied to other sheet
    Const strRANGE as String = "E2:H2"

    set shSource=Sheets("Sheet1")
    set shTarget=Sheets("Sheet2")

    'Copy range from source sheet (sheet1)
    shSource.Range(strRANGE).copy

    'Paste range from Source sheet(sheet1) to Sheet 2 by matching ID value (cell A2)
     shTarget.Range("A65000").End(xlUp).Offset(1).PasteSpecial xlValues

end sub

类似这样的方法会起作用,您可以利用 Range.Find 函数在目标 sheet 中定位 ID。

Sub copydata()

Set shSource = Sheets("Sheet1")
Set shTarget = Sheets("Sheet2")

Dim fnd As Range

Set fnd = shTarget.Range("A1:A1000").Find(shSource.Range("A2").Value)

   If Not fnd Is Nothing Then
        shSource.Range("E2:H2").Copy
        shTarget.Cells(fnd.row, 5).PasteSpecial xlPasteValues
    End If

End Sub

目前它只适用于第二行,将它放在多行的循环中。