2つのワークシートの比較と行データのコピー

Question

1つのワークブックで2つのワークシートを比較したいと思います。いくつか擬似コード：

もしWorksheet1 =セルWorksheet2上のAと
上のセルAセルF Worksheet1 <上>セルF Worksheet2 Worksheet1上の行を超えるWorksheet2 から次に
コピー行上の他の
もしあればWorksheet1 <上のセルA> Worksheet1
にWorksheet2から次の空白行に

をWorksheet2上 その後
コピー行に細胞

これは私がこれまで持っているものです。

Sub CopyCells() 
Dim sh1 As Worksheet, sh2 As Worksheet 
Dim j As Long, i As Long, lastrow1 As Long, lastrow2 As Long 


Set sh1 = Worksheets("Sheet1") 
Set sh2 = Worksheets("Sheet2") 

lastrow1 = sh1.Cells(Rows.Count, "A").End(xlUp).Row 
lastrow2 = sh2.Cells(Rows.Count, "A").End(xlUp).Row 

For i = 2 To lastrow1 
    For j = 1 To lastrow2 
     If sh1.Cells(i, "A").Value = sh2.Cells(j, "A").Value And sh1.Cells(i, "F").Value <> sh2.Cells(j, "F").Value Then 
      sh1.Cells(i, "F").Value = sh2.Cells(j, "F").Value 
     End If 
    Next j 
Next i 

End Subの

Answer 1

はこれを試してみてください：

Sub CopyCells() 
    Dim sh1 As Worksheet, sh2 As Worksheet 
    Dim i As Long, j As Long, lastrow1 As Long, lastrow2 As Long, counter As Long 

    Set sh1 = Worksheets("Sheet1") 
    Set sh2 = Worksheets("Sheet2") 

    lastrow1 = sh1.Cells(Rows.Count, "A").End(xlUp).Row 
    lastrow2 = sh2.Cells(Rows.Count, "A").End(xlUp).Row 
    counter = 1 

    For i = 1 To lastrow1 
     For j = 1 To lastrow2 
      If sh1.Range("A" & i) = sh2.Range("A" & j) And sh1.Range("F" & i) <> sh2.Range("F" & j) Then 
       sh2.Range("A" & j).EntireRow.Copy Destination:=sh1.Range("A" & i) 
      ElseIf sh1.Range("A" & i) <> sh2.Range("A" & j) Then 
       sh2.Range("A" & j).EntireRow.Copy Destination:=sh1.Range("A" & lastrow1 + counter) 
       counter = counter + 1 
      End If 
     Next j 
    Next i 
End Sub