如何将复制的行从一张纸粘贴到另一张纸上
我有两个Excel工作表：Sheet1和Sheet2。 Sheet2是主列表，而Sheet1是从系统接收的更新工作表。 我需要的是比较Sheet1的列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
这里有一个关于如何使用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
这段代码可能会帮助你（警告：没有任何testing书面）
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将在重复的键值上失败 – 所以如果这是一种可能性，你需要添加一些额外的检查
用这个 ：
Sheet2.Select (Sheet1.Rows(index).Copy) // Index is copy row index in sheet1 Sheet2.Paste (Rows(index)) // Index is Paste row index in sheet2