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

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

这是有关如何使用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 2

用这个 ：

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

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

Answer 3

该代码段可能会对您有所帮助（警告：未经任何测试就编写）

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将在重复的键值上失败-因此，如果有可能，您需要添加一些额外的检查