将数据从一个shee复制到另一个替换而不是追加

Question

我想知道这段代码中的错误。我的目标是将数据从sheet2复制到sheet1。该代码正在工作，但将复制到shee1的记录替换为row1中的数据，但不会附加。我想要将数据复制到每一行下面。

Set ws = Sheets("Sheet2") 
    With ws 
     Set rngsh1 = .UsedRange 
    End With 
    For Each cel1 In rngsh1 
      With Sheets("Sheet1") 
       Set rng = .Rows(1).Find(cel1, LookIn:=xlValues, LookAt:=xlWhole) 
       If Not rng Is Nothing Then 
        cel1.Offset(, 1).Copy .Cells(rng.Row + 1, rng.Column) 
       End If 
      End With 

    Next 

Answer 1

这将从Sheet2中追加值到新行工作表Sheet1上：

For Each cel1 In Worksheets("Sheet2").UsedRange 

    With Worksheets("Sheet1") 

     Set rng = .UsedRange.Rows(1).Find(cel1, LookIn:=xlValues, LookAt:=xlWhole) 

     If Not rng Is Nothing Then 
      .Cells(.UsedRange.Rows.Count + 1, rng.Column) = cel1.Offset(, 1) 
     End If 

    End With 

Next 

但您最初的代码只搜索行1工作表Sheet1上。我要搜索的所有值：

For Each cel1 In Worksheets("Sheet2").UsedRange 

    With Worksheets("Sheet1") 

     Set rng = .UsedRange.Find(cel1, LookIn:=xlValues, LookAt:=xlWhole) 

     If Not rng Is Nothing Then 
      .Cells(.UsedRange.Rows.Count + 1, rng.Column) = cel1.Offset(, 1) 
     End If 

    End With 

Next