將數據從一個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