如何将复制的行从一张表粘贴到另一张表

Question

我有两个 Excel 工作表：Sheet1 和 Sheet2。 Sheet2 是主列表，而 Sheet1 是我从系统收到的更新工作表。我需要将 Sheet1 的 Col A 的每个值与 Sheet2 进行比较。如果有匹配项，那么我想从 Sheet1 复制整个匹配行并将该行中的值粘贴到 Sheet2 的相应 ColA 值 (Item#) 行。示例如下：

Sheet1 工作表

ColA                                      ColB

Item#                                     Updated Cost

1234                                      $30

Sheet2 工作表

ColA                                      ColB

Item#                                     Current Cost

1234                                      $45

我的文件中的列比此处显示的多，因此有必要将整行与 Sheet2 中的相应行一起复制。我启动了所需的 Excel VBA 代码，但我坚持在 Sheet2 中粘贴相应的值。我的代码非常基本，但还不能正常工作，因此感谢任何与编码相关的帮助。

Sub Macro1()
'
' Macro1 Macro
'
'   Copies corresponding item# rows from sheet1 worksheet
'   to sheet2 worksheet by comparing item# column

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ColA As String
Dim rng1 As Range
Dim rng2 As Range
Dim RowCounter1 As Integer
Dim RowCounter2 As Integer

ColA = "A"

RowCounter1 = 2
RowCounter2 = 2

Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")

Do While Not IsEmpty(ws1.Range(ColA & RowCounter1).Value)

    Set rng1 = ws1.Range(ColA & RowCounter1)

    RowCounter2 = 1
    Do While Not IsEmpty(ws2.Range(ColA & RowCounter2).Value)

        Set rng2 = ws2.Range(ColA & RowCounter2) 
        If rng1.Value = rng2.Value Then 
             Rows(RowCounter1).EntireRow.Copy                  
             RowCounter2 = RowCounter2 - 1  
        End If
        RowCounter2 = RowCounter2 + 1

    Loop
    RowCounter1 = RowCounter1 + 1
Loop

End Sub

Answer 1

这个sn-p可能对你有帮助（警告：未经任何测试编写）

Dim RowCollection As New Collection

Dim rgRow1 As Range
For Each rgRow1 In RangeFromSheet1
    ' saves each sheet1 row indexed by the (string) value of the 1st cell
    Call RowCollection.Add(rgRow, CStr(rgRow1.Cells(1, 1).Value))
Next rgRow1

Dim rgRow2 As Range
For Each rgRow2 In RangeFromSheet2
    ' try to find matching row
    On Error Resume Next
    Set rgRow1 = Nothing
    Set rgRow1 = RowCollection(CStr(rgRow2.Cells(1, 1).Value)) ' lookup using sheet2 val
    On Error GoTo 0
    If Not rgRow1 Is Nothing Then
        rgRow2.Value = rgRow1.Value ' found a match, so copy values
    End If
Next rgRow2

注意：RowCollection.Add 将在重复键值上失败 - 因此，如果有可能，您需要添加一些额外的检查

Answer 2

下面是关于如何使用 PasteSpecial 方法和一些代码简化的方法：

Sub Macro1()

'
' Macro1 Macro
'
'   Copies corresponding item# rows from sheet1 worksheet
'   to sheet2 worksheet by comparing item# column

Dim rng1 As Range, rng2 As Range

For Each rng1 In Worksheets("Sheet1").Range("A2").Resize(Worksheets("Sheet1").Range("A2").CurrentRegion.Rows.Count - 1).Rows
  For Each rng2 In Worksheets("Sheet2").Range("A2").Resize(Worksheets("Sheet2").Range("A2").CurrentRegion.Rows.Count - 1).Rows
    If rng2(1).Value = rng1(1).Value Then
      rng1.EntireRow.Copy
      rng2.EntireRow.PasteSpecial (xlPasteValues)
    End If
  Next rng2
Next rng1

End Sub

Answer 3

使用这个：

Sheet2.Select (Sheet1.Rows(index).Copy)     // Index is copy row index in sheet1

Sheet2.Paste (Rows(index))       // Index is Paste row index in sheet2